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前 言 


随 着 当今 社会 经 济 与 信息 技术 的 飞速 发 展 ， 人 们 每 天 接触 到 的 信息 量 与 以 往 不 可 同日 而 
语 。 无 论 是 个 人 还 是 企业 ， 要 管理 好 这 些 信 息 都 是 一 份 相 当 重 要 的 工作 。Excel 2007 是 一 款 很 
强大 的 数据 处 理 和 计算 分 析 软 件 ， 并 且 已 经 为 广大 用 户 接受 。 笔 者 有 理由 相信 ， 大 多 数 读者 
都 曾经 或 正在 使 用 Excel， 并 且 接 触 到 VBA 开发 功能 。 

本 书 正 是 基于 以 上 两 点 ， 以 Excel 2007 为 平台 ， 通 过 众多 实例 展现 Excel 2007 强大 的 数 
据 处 理 与 分 析 功 能 ， 让 未 接触 到 VBA 开发 的 读者 步 入 VBA 开发 的 殿堂 ， 让 已 了 解 VBA 开发 
的 读者 积累 更 多 的 实战 经 验 。 

本 书 的 内 容 并 不 局 限于 Excel 2007 本 身 的 内 容 。 在 本 书 讲解 的 部 分 实例 中 将 Excel 2007 
与 数据 库 结 合 起 来 ， 极 大 地 提高 数据 处 理 与 分 析 的 速度 。 而 Excel 2007 的 工作 短文 件 本 身 也 
可 以 被 认为 是 一 个 数据 库 ， 在 本 书 中 也 有 相应 实例 展现 如 何 操作 Excel 数据 库 文件 。 


本 书 特 点 


1. 循序 渐进 ， 由 浅 入 深 

本 书 针对 广大 用 户 的 情况 , 采取 由 浅 入 深 的 方式 展开 。 本 书 前 3 章 是 基础 章节 , 介绍 Excel 
VBA 开发 的 基础 知识 ， 包 括 熟悉 VBE 开发 环境 、VBA 程序 设计 基础 和 Excel 对 象 模型 知识 。 
在 实例 的 安排 上 ， 前 面 的 章节 讲述 的 基本 上 是 较为 简单 的 实例 ， 复 杂 的 实例 都 放置 在 本 书后 
面 的 章节 。 

2. 实用 实例 ， 内 容 丰 富 

本 书 中 所 讲述 的 实例 都 具有 很 强 的 实用 价值 。 实 例 用 途 各 不 相同 ， 其 开发 方式 也 各 不 一 
样 ， 部 分 实例 之 间 的 开发 方式 还 具有 较 强 的 比较 性 ， 用 户 可 以 根据 各 自 的 优 缺 点 采用 相应 的 
开发 方式 。 在 选材 上 ， 也 不 单一 地 选择 商业 应 用 方向 的 实例 。 

3. 知识 点 提示 ， 加 深 理 解 

在 本 书 的 实例 章节 中 ， 基 本 上 都 会 有 知识 点 提示 。 这 些 知识 点 都 是 对 应 章节 中 使 用 到 的 
难点 与 重点 知识 。 了 解 并 熟练 掌握 这 些 知 识 不 仅 便于 实例 理解 ， 也 可 丰富 读者 的 开发 途径 。 
安排 知识 点 在 每 个 章节 前 面 便于 读者 及 时 查找 疑点 问题 ， 加 深 理解 。 

4. 注释 详细 ， 图 文 并 茂 

本 书 的 程序 代码 都 使 用 统一 的 格式 标识 ， 在 代码 块 的 每 一 句 后 面 都 会 标识 注释 ， 对 该 语 
句 完成 什么 工作 加 以 说 明 。 对 于 比较 复杂 的 过 程 或 函数 ， 为 了 能 够 让 读者 更 容易 理解 其 意图 ， 
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在 讲述 中 不 仅 通过 文字 说 明 其 运行 流程 ， 还 通过 流程 图 展示 其 过 程 ， 其 中 的 一 些 重 点 与 难点 
都 在 其 中 加 以 讲述 。 


5. 配 有 光盘 ， 加 速 学 习 
本 书 配套 光盘 中 包含 了 书 中 相关 操作 内 容 以 及 各 个 实例 的 源 文件 。 


本 书 内 容 


第 1 章 : 如 果 读 者 还 是 一 个 新 手 ， 这 一 章 将 引导 读者 步 入 VBA 开发 殿堂 。 这 部 分 内 容 包 
括 熟 悉 VBE 开发 环境 、 调 试 工具 和 认识 宏 。 

第 2 章 : 该 章节 介绍 VBA 程序 设计 基础 。 内 容 包 括 数据 类 型 、 常 量 、 变 量 、 过 程 与 函数 、 
表达 式 与 运算 符 、 结 构 语 句 和 数组 。 

第 3 章 : 本章 对 Excel 对 象 模型 进行 了 比较 简单 的 介绍 。 由 于 Excel 对 象 模型 包含 的 对 象 
繁多 ,本章 只 讲述 4 个 主干 对 象 的 常用 属性 和 方法 ,这 些 主 干 对 象 是 应 用 程序 对 象 Application、 
工作 短 对 象 WorkBook、 工 作 表 对 象 WorkSheet 和 单元 格 区 域 对 象 Range。 

第 4~9 章 : 这 一 部 分 包含 了 6 个 较 简单 的 实例 ， 其 复杂 程度 依次 呈 上 升 趋势 。 这 一 部 分 
的 实例 涉及 客户 管理 、 学 生成 绩 管理 、 固 定 资产 管理 、 进 销 存 管理 、 ae 
理 。 涉 及 的 知识 点 包括 窗 体 的 设计 、 工 作 表 界面 设计 、 数 据 有 效 性 、 自 动 筛选 、 单 元 格 控制 、 
自 定义 菜单 、 名 称 、 工 作 表 函数 应 用 和 加 载 宏 等 。 

第 10~12 章 : 这 一 部 分 包含 了 3 个 较为 复杂 的 实例 ， 大 部 分 都 使 用 到 了 数据 库 知 识 。 这 3 
个 实例 分 别 是 学 生 座 位 编排 、 合 同 管理 、 拆 分 和 备份 工作 短工 具 。 涉 及 的 知识 点 包括 工作 表 
可 见 性 、 保 护 与 撤销 工作 表 保护 、DAO/ADO 数据 库 对 象 、SQL 查询 、ADOX 对 象 。 
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第 1 章 初 识 Excel 2007 VBA 


本 章 以 及 后 续 的 两 个 章节 是 Excel 2007 VBA 知识 的 葛 基 章节 。 本 章 主要 讲解 Excel 2007 
VBA 的 开发 环境 (VBE) 、 调 试 工具 和 宏 的 使 用 方法 。“ 工 欲 善 其 事 ， 必 先 利 其 器 ”， 认 真 
掌握 该 部 分 内 容 ， 可 以 极 大 地 提高 开发 者 的 开发 效率 与 调试 效率 。 


1.1 VBA 的 能 力 


这 些 年 笔者 在 所 工作 的 每 个 地 方 几乎 都 会 问 周 围 经 常 使 用 Excel 进行 数据 分 析 与 管理 的 
同事 同一 个 问题 ,为 什么 不 使 用 VBA 处 理 那 些 繁琐 的 日 常事 务 ? 得 到 的 回答 不 外 乎 以 下 答案 : 
VBA 是 什么 ， 有 用 吗 ; VBA 太 难 了 ,看 了 很 多 书 也 不 得 要 领 ， 不 知道 怎么 把 它 运 用 到 实际 工 
作 中 。 

笔者 想 ， 翻 看 本 书 的 读者 也 有 很 大 部 分 存在 以 上 的 疑惑 。 对 于 前 者 笔者 想 打 个 比方 来 说 ， 
聚会 的 时 候 大 家 都 喜欢 喝 啤 酒 ， 可 是 开启 啤酒 瓶 就 “八仙 过 海 ， 各 显 神通 ”了 ， 有 的 练 牙齿 
功夫 ， 有 的 抓 着 啤酒 瓶子 照 着 萎 角 分 明 的 桌子 或 其 他 硬 物 上 敲 ， 有 的 摇动 啤酒 瓶 来 个 井喷 ， 
但 是 对 于 笔者 而 言 更 喜欢 拿 权 子 来 解决 问题 ! VBA 就 像 开 啤酒 瓶 的 权 子 。 

笔者 的 一 位 同学 曾经 磁 到 一 个 问题 ， 同 学 有 十 几 个 工作 敌 ， 每 个 工作 短 只 有 一 个 表 ， 每 
个 表 里 有 10000 行 左右 ， 而 其 工作 即 是 将 里 面部 分 数据 行 删 除 。 删 除 的 规律 是 ， 电 话 号 码 列 
包括 座机 号 〈 带 区 号 ) 或 手机 号 ， 该 列 最 多 包括 两 个 号 码 ， 如 果 有 两 个 电话 时 ， 使 用 “/” 隔 
开 ， 而 需要 删除 的 是 那些 只 有 座机 号 的 行 。 

在 碰 到 该 问题 之 前 ， 笔 者 的 同学 并 不 会 使 用 自动 筛选 、 函 数 等 功能 ， 更 不 用 说 VBA， 因 
而 只 能 完全 手动 操作 。10 多 万 行 数据 ， 一 行 一 行 手动 处 理 ， 这 是 很 大 的 工作 量 ! 需要 多 少时 
间 和 精力 处 理 ? 当 同 学 求助 于 我 时 ， 我 使 用 两 个 方法 解决 了 该 问题 。 

其 一 是 使 用 自动 筛选 和 函数 。 首 先 新 建 一 个 列 ， 该 列 使 用 函数 按照 “/” 分 开 两 个 电话 号 
码 。 然 后 取得 两 个 号 码 的 第 一 位 数 ， 把 它们 相 加。 如 果 都 是 座机 号 ， 那 么 这 个 数字 一 定 为 0。 
如 果 包 含 了 手机 号 , 该 结果 将 大 于 0。 然后 通过 自动 筛选 , 将 该 列 为 0 的 数据 筛选 出 来 后 删除 。 

其 二 是 写 一 个 加 载 宏 ， 在 这 个 加 载 宏 里 面包 含 了 一 个 自 定义 函数 。 函 数 返 回 的 就 是 前 面 
相 加 的 结果 。 对 于 每 一 个 工作 敌 将 省 去 每 次 都 需要 手动 书写 公式 的 麻烦 。 两 种 方法 大 体 上 是 
一 样 的 ， 区 别 只 是 前 者 完全 是 通过 Excel 2007 的 界面 操作 完成 ， 而 后 者 通过 编程 完成 ， 前 后 


只 花 几 分 钟 的 时 间 。 
由 此 可 以 看 出 ， 全 面 了 解 Excel 2007 的 功能 和 掌握 一 部 分 编程 技巧 ， 将 极 大 地 提高 办 公 
效率 。 


Ah 
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是 发 现 问 题 、 分 析 问 题 的 思维 过 程 。 笔 者 建议 在 阅读 本 书 的 实例 时 ， 首 先 构 思 一 下 应 该 如 何 
完成 该 系统 ， 然 后 把 解决 方案 实现 出 来 ， 最 后 再 来 看 笔者 的 方案 是 如 何 做 的 。 
到 底 VBA 能 帮助 使 用 者 做 哪些 工作 呢 ? 其 实 这 个 问题 很 难 界定 ， 使 用 VBA 开发 应 用 是 
一 份 创造 性 的 工作 ， 在 很 大 程度 上 依赖 于 开发 者 本 人 的 创造 力 。 但 是 有 一 点 是 必然 的 ，VBA 
是 一 种 程序 语言 ， 它 需要 有 确切 的 执行 规律 。 

例如 电话 号 码 列 ， 如 果 没 有 “/” 分 割 两 个 号 码 或 者 座机 号 码 不 带 区 号 ， 那 么 后 面 所 使 用 
的 解决 办 法 就 不 能 有 效 执行 了 。 往 往 笔者 在 使 用 VBA 开发 应 用 时 ， 第 一 步 就 是 找到 潜在 的 规 
律 ， 因 此 每 一 个 疑难 问题 的 前 期 分 析 问 题 步骤 很 重要 。 


在 Excel 2007 中 处 理 数据 时 ， 经 常 需要 按照 某 些 条 件 对 数据 进行 筛选 ， 通 常 可 以 采用 自 
动 筛选 功能 实现 。 但 是 有 时 候 筛选 的 条 件 十 分 复杂 或 者 需要 筛选 出 某 列 的 不 重复 项 ， 此 时 就 
需要 高 级 筛选 。 自 动 筛选 将 在 第 5 章 学 生成 绩 管 理 系统 中 介绍 ， 读 者 可 以 通过 该 章 的 知识 点 
了 解 该 功能 。 由 于 本 章 的 实例 中 接触 到 了 高 级 筛选 ， 因 而 将 高 级 筛选 的 知识 在 此 加 以 介绍 。 

高 级 筛选 的 操作 既 可 以 通过 菜单 实现 操作 也 可 以 使 用 VBA 代码 实现 ， 详 细 的 界面 操作 可 
以 参见 1.4.2 节 的 介绍 。 这 里 详细 介绍 高 级 筛选 的 代码 实现 及 其 语法 格式 的 解释 。 高 级 筛选 是 
通过 单元 格 对 象 或 区 域 的 AdvancedFilter 方法 实现 的 。 该 方法 的 语法 如 下 : 

表达 式 .AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique) 


该 方法 的 几 个 参数 的 意义 如 下 。 

口 ”Action 参数 : 必 选 参数 。 用 于 指定 是 否 就 地 复制 或 筛选 列表 。 

口 CriteriaRange 参数 : 可 选 参数 。 该 参数 制定 条 件 区 域 ， 如 果 省 略 该 参数 ， 则 没有 条 件 
限制 。 

口 CopyToRange 参数 : 可 选 参数 。 如 果 Action 为 xlFilterCopy， 则 为 复制 行 的 目标 区 域 ; 
否则 ， 和 忽略 该 参数 。 

口 、Unique 参数 : 可 选 参 数 。 如 果 为 True， 则 只 筛选 唯一 记录 ; 如 果 为 False， 则 筛选 
符合 条 件 的 所 有 记录 。 默 认 值 为 False。 

这 里 不 再 列 出 该 方法 的 实例 ， 读 者 可 以 参见 本 章 最 后 一 节 中 录制 宏 实例 小 节 的 代码 。 


1.2 认识 VBA 编辑 器 (VBE ) 


在 正式 进入 Excel VBA 开发 之 前 , 有 必要 了 解 一 下 VBE 开发 环境 .图 1-1 显示 了 一 个 VBE 
开发 环境 界面 ， 从 图 中 可 以 看 到 VBE 开发 环境 的 3 个 基本 组 成 部 分 : 工程 资源 管理 器 、 属 性 
和 程序 设计 窗口 。 要 从 Excel 2007 的 界面 进入 VBE 可 以 采用 两 种 方式 : 

口 按 AltF11 组 合 键 。 

口 将 Visual Basic 编辑 器 按钮 设置 在 快速 工具 栏 上 。 在 Excel 2007 的 快速 工具 栏 ( 如 


证 / 


图 1-2 所 示 ) 上 单 击 所 按钮 ， 在 随后 弹出 的 菜单 中 选择 【其 他 命令 】 选 项 〈 如 图 1-3 
所 示 ) ， 即 会 弹出 自 定义 Excel 选项 窗口 (如 图 1-4 所 示 ) 。 在 该 窗口 的 选择 命令 下 
拉 列 表 框 中 选择 【所 有 命令 】， 然 后 在 其 下 方 的 列表 框 中 选择 【Visual Basic】 选 项 ， 
单 击 【添加 】 按 钮 。 确 认 后 在 快速 工具 栏 上 将 会 出 现 快速 访问 VBE 的 按钮 。 
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图 1-4 Excel 选项 
1.2.1 VBE 环境 的 设置 


VBE 中 的 环境 设置 可 以 允许 用 户 自行 定制 ， 开 发 者 可 以 按照 自己 的 习惯 设置 这 些 选 项 。 
下 面 讲述 几 个 经 常 使 用 到 的 较 有 帮助 的 环境 设置 。 

依次 选择 【工具 】|【 选 项 】|【 编 辑 器 】 命 令 〈 如 图 1-5 所 示 ) ， 选 中 【要 求 变量 声明 】 
复 选 框 。 该 复 选 框 被 选中 后 , 编辑 器 会 自动 在 每 个 Microsoft Excel 对 象 、 模 块 和 窗 体 的 代码 段 
首 行 插入 下 列 语句 : 

Option Explicit 


| 
篇 可 器 | 护 二 器 格式 | 通用 。 | 可 连接 的 | 
[代码 设置 


[本 w | ww | 
图 1-5 VBE 环境 设置 


当代 码 段 首 行 出 现 该 语句 时 ， 在 代码 中 必须 使 用 Dim、Private、Public 或 ReDim 语句 显 
式 声 明 所 有 变量 。 试 图 使 用 未 声明 的 变量 名 将 发 生 编译 错误 。 使 用 Option Explicit 可 避免 拼 错 


ep 


办 公 应 用 意 党 之 多 


Excel VBA 应 用 开发 经 典 案例 


现 有 变量 的 名 称 ， 或 避免 在 变量 范围 不 清楚 的 代码 中 产生 混淆 。 
另外 ， 在 【通用 】 选 项 卡 中 可 以 设置 窗 体 设计 时 网 格 的 间距 。 在 选中 了 【对 齐 到 网 格 】 
复 选 框 的 情况 下 ， 设 置 一 个 比较 小 的 间距 单位 有 利于 窗 体 的 编辑 操作 。 这 个 值 可 以 设置 的 范 


1.2.2 VBE 编辑 器 工具 栏 


围 为 2~60〈 磅 ) ， 笔 者 习惯 设置 为 2。 


VBE 编辑 器 工具 栏 包括 常用 的 功能 工具 按钮 (如 图 1-6 所 示 ) 。 该 工具 栏 包含 了 3 部 分 
按钮 ， 前 面 两 个 按钮 用 于 切换 到 Excel 2007 界面 和 插入 用 户 自 定义 对 象 ， 这 些 对 象 包括 用 户 
窗 体 、 模 块 、 类 模块 和 过 程 。 中 间 部 分 是 编辑 按钮 ， 包 括 保存 、 剪 切 、 复 制 、 粘 贴 、 查 找 、 
撤销 和 重复 。 随 后 的 一 些 按钮 用 于 VBA 程序 调试 及 打开 管理 器 窗口 ， 包 括 运行 程序 、 中 断 、 


国 习 - 回 


Ieoxd yosomIN 而 洲 一 | 
小 关 痰 了 而 下 了 工 洱 > 襄 一 


重新 设置 、 设 计 模式 、 工 程 资源 管理 器 、 属 性 窗口 、 对 象 浏览 器 和 工具 箱 。 


友 于 一 = 
El 
出 落 半 二 一 区 
忆 或 序 击 一 如 

昔 苹 坚 锥 泽 一 上 

E> 
€ 


六 融 闻 一 ” 
效 冉 芝 蘑 洲 山 睹 一 名 


图 1-6 VBE 编辑 器 工具 栏 


1.2.3 ”工程 资源 管理 器 


工程 资源 管理 器 实现 了 对 Excel 2007 VBA 工程 文件 资源 的 统一 管理 。 该 管理 器 列 出 了 所 
有 已 打开 的 工作 筹 和 所 加 载 的 附加 项 《例如 加 载 安 》 。 要 显示 该 管理 器 窗口 ， 有 3 种 方法 : 
一 种 是 依次 选择 【视图 】| 【工程 资源 管理 器 】 命 令 ， 一 种 是 按 Ctrl+R 快捷 键 ; 一 种 是 单 击 工 


具 栏 中 的 【工程 资源 管理 器 】 按 钮 。 对 于 每 个 VBA 工程 ， 都 


程 


只 可 能 包含 4 类 对 象 ，Microsoft Excel 对 象 、 窗 体 、 模 块 和 类 


模块 ， 工 程 资 源 管 理 器 如 图 1-7 所 示 。 


口 Microsoft Excel 对 象 : 该 对 象 下 包含 了 Excel 的 表 对 a 
象 和 Thisworkbook 工作 簿 对 象 ， 双击 某 个 对 象 ,将 进 a 
入 该 对 象 的 代码 编辑 窗口 。 2 
口 、 窗 体 : 用 户 自 定义 的 对 话 框 或 窗 体 界面 ， 用 于 辅助 输 ee” 8 
入 或 显示 输入 。 双 击 后 将 会 显示 窗 体 。 如 果 要 查看 窗 | “信人 
体 代码 ， 需 要 右 击 窗 体 ， 然 后 选择 查看 代码 。 A 
口 模块， 保存 自 定义 VBA 代码 ， 录 制 宏 时 ， 新 录制 的 emer 


宏 也 将 保存 在 该 处 。 双 击 时 可 以 直接 进入 代码 编辑 。 图 1-7 工程 资源 管理 器 
口 ”类 模块 : 保存 以 类 或 对 象 方式 编写 的 代码 。 通 过 创建 


Ah 
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类 模块 ， 可 以 创建 用 户 自 定义 的 类 和 对 象 。 使 用 已 建立 的 类 模块 ， 不 需要 编码 者 了 
解 它 具 体 是 如 何 工作 的 ， 因 此 可 以 实现 共享 代码 。 
Microsoft Excel 对 象 中 包含 的 对 象 不 能 在 VBE 环境 下 添加 或 删除 。 当 用 户 需要 添加 或 删 
除 其 中 的 对 象 时 (例如 工作 表 ) ， 可 返回 Excel 2007 操作 界面 操作 。 其 他 3 种 对 象 的 添加 有 3 
种 方式 : 
口 ”选择 【插入 】 菜 单 ， 然 后 选择 插入 的 对 象 类 型 。 
口 “ 右 击 工程 文件 名 ， 选 择 【插入 】 选 项 ， 此 时 可 以 选择 插入 的 对 象 类 型 。 
口 在 VBE 编辑 工具 栏 上 单 击 第 二 个 按钮 国 国 右 边 的 下 拉 箭 头 ， 选 择 插入 对 象 类 型 。 


1.2.4 属性 窗口 


在 属性 窗口 中 ， 可 以 查看 和 设置 工程 中 不 同 对 象 的 属 
性 , 包括 工作 表 、 工 作 短 、 模 块 和 窗 体 控件 。 在 属性 窗口 中 ， 
对 象 的 属性 可 以 按照 两 种 方式 查看 , 分 别 是 按 字 母 序 查 看 和 
按 分 类 序 查看 〈 如 图 1-8 所 示 ) 。 只 需 单 击 属性 窗口 中 对 应 
的 标签 就 可 以 进入 相应 的 查看 模式 。 

口 “ 按 字母 序 : 按 字母 顺序 列 出 被 选择 对 象 的 所 有 属 。 saw 

性 。 选 择 属性 名 , 输入 或 选择 新 设置 即 可 修改 属性 eset er 


Left 


设置 。 ouseTcon Oone) 

口 “ 按 分 类 序 : 按 类 别 列 出 选中 对 象 的 所 有 属性 。 可 以 图 1.8 属性 窗口 
将 清单 折 登 起 来 以 便 查看 。 不 同 对 象 展现 的 类 别 
并 不 一 致 。 


属性 窗口 除了 可 以 修改 工程 、 对 象 、 模 块 的 属性 外 ， 更 多 是 用 于 对 用 户 窗 体 各 个 对 象 属 
性 的 交互 设计 。 调 用 属性 窗口 的 方法 如 下 : 

口 选择 【视图 】 菜 单 ， 然 后 选择 【属性 】 命 令 。 

口 在 键盘 上 按 F4 快捷 键 。 

口 从 工具 栏 中 单 击 【 属 性 窗口 】 按 钮 。 


1.2.5 ”代码 窗口 


在 工程 资源 管理 器 的 对 象 上 双击 可 开启 该 对 象 的 代码 窗口 , 查看 或 编辑 该 对 象 的 代码 (如 
图 1-9 所 示 ) 。 在 这 里 可 以 完成 查看 修改 录制 的 宏 代 码 和 现存 的 VBA 工程 代码 工作 。 

给 对 象 编写 代码 时 ， 一 般 的 操作 是 : 首先 从 【对 象 】 下 拉 列 表 框 中 选择 需要 编程 的 对 象 ， 
图 中 选择 了 Label 客户 管理 标签 对 象 ， 然 后 需要 选择 相应 的 事件 ，VBE 将 自动 生成 事件 过 程 
的 结构 代码 ， 用 户 在 该 结构 中 输入 代码 即 可 。 

代码 窗口 的 显示 方式 有 两 种 : 全 模式 视图 和 过 程 视图 。 在 代码 窗口 的 左下 方 可 以 找到 各 
自 的 激活 按钮 。 下 面具 体 介绍 这 两 种 显示 方式 。 


对 象 下 拉 列表 框 十 js 要 六 全 4 后 ie 半生 事件 下 拉 列 表 框 
习 


Private Sub Label 客 户 管理 ClickO 〇 
IO Show 
ub 


vate Sub Labe] 客 户 管 理 Nousellove (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Sin 
客户 管理 ” a 


全 模式 视图 模式 Be 革 放 re ma As Integer, ByVal Shift As Integer, ByVal X As -| 
Private Sub_ Label 进 销 存 Nousellove (ByYal Button As Integer, ByYal Shift As Integer, ByYel X As Singl 
hngefeee “者 销 三 lg 

过 程 视图 模式 上 4 J 
图 1-9 代码 窗口 
口 ”全 模式 视图 : 默认 项 ， 在 代码 窗口 中 显示 该 对 象 的 每 个 子 过 程 代码 。 
口 ”过程 视图 : 只 显示 当前 过 程 代 码 。 


要 开启 某 个 对 象 的 代码 窗口 可 以 采取 以 下 3 种 方法 : 

口 在 工程 浏览 器 窗口 中 选择 需要 的 用 户 窗 体 或 者 模块 ， 然 后 单 击 【 查 看 代码 】 按 钮 。 
口 在 菜单 中 依次 选择 【视图 】| 【代码 】 命 令 。 

口 在 键盘 上 按 F7 快捷 键 。 


1.2.6 ”对 象 浏览 器 


对 象 浏览 器 (如 图 1-10 所 示 ) 用 于 查看 该 工程 中 所 有 引用 、 控 件 的 属性 方法 和 事件 的 浏 
览 器 以 及 VBA 全 局 常量 。 通过 该 窗口 , 可 以 方便 而 迅速 地 查找 Excel 2007 中 对 象 所 包含 的 类 、 
属性 、 方 法 和 事件 。 找 到 该 对 象 后 ， 单 击 它 ， 然 后 按 Fl 快捷 键 即 可 打开 该 对 象 属性 、 方 法 和 
事件 的 帮助 文档 。 该 窗口 是 一 个 强 有 力 的 VBA 应 用 开发 辅助 窗口 。 打 开 该 窗口 的 方式 有 两 种 : 


图 1-10 ”对象 浏览 器 


口 “在 菜单 中 依次 选择 【视图 】|【 对 象 浏览 器 】 命 令 。 
口 在 VBE 环境 中 ， 按 F2 快捷 键 。 


_ 
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1.3 VBE 调试 工具 


VBE 开发 环境 提供 了 几 个 常用 的 调试 工具 。 人 恰当 地 使 用 这 些 工 具 ， 对 于 查看 宏 代 码 与 定 
位 问题 代码 段 十 分 有 用 ， 极 大 地 提高 了 开发 效率 。 这 些 工具 包括 逐 句 调试 、 断 点 设置 、 设 置 
下 一 条 语 多、 运行 到 光标 、 立 即 窗口 、 基 浮 窗口 和 监视 窗口 ， 以 下 将 分 别 介绍 。 


1.3.1 逐 句 调试 


在 通常 情况 下 ， 宏 代码 将 被 全 部 逐 行 执行 ， 这 个 过 
程 很 快 , 一 旦 出 现 问 题 , 不 便于 查找 问题 所 在 。 而 使 用 
逐 句 调试 , 可 以 一 次 运行 一 句 代码 , 便于 查找 问题 代码 


行 所 在 。 在 菜单 中 选择 【调试 】|【 逐 语句 】 或 者 按 F8 wt 

快捷 键 都 可 以 进入 逐 语句 调试 模式 。 进入 该 模式 后 Bi So. ER on Button As | 
当前 被 执行 的 代码 语句 将 会 用 黄色 突出 显示 ， 同 时 代 “| [sa 
码 左 侧 会 显示 一 个 黄色 箭头 ， 该 效果 如 图 1-11 所 示 。” 匡 : Ea 


再 次 选择 【 逐 句 语句 】 或 按 F8 快捷 键 ， 程 序 将 执行 该 图 1-11 逐 句 调试 
语句 行 ， 并 跳 转 到 下 一 条 语句 。 


1.3.2 ” 断 点 设置 


如 果 运 行 的 代码 行 数 很 多 , 使 用 逐 句 调试 显得 很 繁琐 。 特别 是 问题 代码 行 所 处 位 置 比较 靠 
后 时 ,一 次 执行 很 耗费 时 间 。 当 知道 问题 行 大 概 的 所 在 
位 置 时 ， 可 以 设置 一 个 断 点 ， 让 程序 运行 到 该 断 点 时 中 
断 ,然后 使 用 前 面 讲 的 逐 句 调试 ， 逐 句 执行 语句 。 这 样 
可 以 迅速 定位 问题 的 真实 所 在 ， 提 高 调试 代码 的 效率 。 
要 设置 断 点 ， 首 先 在 需要 中 断 的 代码 行 左 侧 单 击 。 


”ia Lab 客户 管理 
此 时 , 一 个 褐色 的 圆 点 将 会 显示 在 代码 行 左 侧 , 该 代码 = oom 


行 也 将 会 突出 显示 为 褐色 (如 图 1-12 所 示 ) 。 当 程序 “| 二, 
运行 到 该 行 代码 时 , 程序 中 止 执 行 , 该 行 代 码 将 突出 显 


加 Se 图 1-12 断 点 设置 
示 为 黄色 ， 意 即 该 行为 当前 执行 行 。 


1.3.3 ”设置 下 一 条 语句 


当 逐 句 调试 代码 时 ， 可 能 需要 跳 过 某 些 代码 ， 或 者 已 经 修改 了 某 些 代码 ， 现 在 需要 了 
运行 时 ， 都 需要 重新 设置 下 一 条 运行 代码 的 位 置 。 可 以 采用 的 方法 有 以 下 两 种 : 


同 
举 


口 使 用 鼠标 将 该 黄色 箭头 拖 动 到 下 一 条 需要 运行 的 语句 的 前 面 ( 如 图 1-13 所 示 ) 
口 在 需要 跳 转 到 的 行 中 单 击 一 下 ， 然 后 选择 【调试 】| 【设置 下 一 条 语句 】 命 令 。 


~ 堵 户 管理 系统 -xls - Sheet1 (代码 ) 
Ebel 客 户 列表 司 (aie 


Private Sub a cli lid 
te ‘eenlpdati 


Private Sub, a (ByYal Button js = 
Sg “客户 列表 


Private Sub Label} 进 销 存 Nousellove ByVal Button As Inte 
| 


图 1-13 设置 下 一 条 语句 
各 注意 : 在 做 该 操作 前 ， 首 先 需要 进入 逐 句 调试 模式 。 


1.3.4 ”运行 到 光标 


当 逐 句 调试 代码 时 ， 可 能 需要 一 次 性 运行 一 段 代码 ， 而 不 是 一 步 一步 地 执行 。 在 调试 循 
结构 时 ， 这 种 情况 经 常 出 现 。 例 如 可 能 需要 让 某 段 代码 循环 运行 100 次 ， 然 后 跳出 循环 ， 
RN， 此 时 可 以 按 Ctrl+F8 组 合 键 或 者 选择 【调试 】 上 运行 到 光标 】 命 令 

来 实现 该 目的 。 


1.3.5 立即 窗口 


立即 窗口 在 调试 中 可 以 完成 查询 变量 的 工作 ， 另 外 它 也 可 以 接受 部 分 命令 语句 ， 例 如 
thisworkbook.save 、sheetl.select 等 。 按 Ctrl+G 组 合 键 即 可 打开 该 窗口 (如 图 1-14 所 示 ) 
当 需 要 查看 某 个 变量 的 值 时 ， 可 以 使 用 debug.Print 命令 语句 和 变量 名 来 查询 。 图 中 例子 使 用 
该 语句 查看 了 当前 工作 竹 的 名 称 。 


图 1-14 立即 窗口 


1.3.6 ”悬浮 窗口 


在 调试 模式 下 ,将 鼠标 芯 浮 在 代码 表达 式 的 上 方 ， 等 待 几 秒 ， 将 会 弹出 一 个 工具 提示 。 
该 工具 提示 显示 当前 表达 式 的 值 ， 效 果 如 图 1-15 所 示 。 图 中 显示 的 提示 是 工作 表 sheet6 中 
Cells(i,1) 单 元 格 的 值 。 


TO 


_ 
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学 生成 于 管 理 系 六 -1.xls - 菜单 路 转 代码 (代码 ) 
| 通用) 了 Jsm 
. 


Dim -本 strCell As String, rowsCount As Integer, i As Integer = 


gn es 2), Cons Qo oat 2) 
6 Cell: 


.Count, 1). End(xlUp). Row 


Me it MertStyle: syalidhertStor, 一 
perator: =x1Betreen, Foraulal:=strCell 

End With 

Set re = Wothing 

na Sub 


图 1-15 ”悬浮 窗口 
1.3.7 ”监视 窗口 


监视 窗口 允许 在 逐 句 运行 代码 时 监视 任何 表达 式 的 值 ， 这 与 立即 窗口 和 悬浮 窗口 的 查询 
功能 类 似 。 当 在 调试 中 需要 检查 很 多 变量 时 ， 使 用 该 窗口 比较 便利 ， 建 立 监 视 也 比较 简便 。 
如 果 和 希望 在 调试 过 程 中 监视 选中 单元 格 的 内 容 ， 即 Selection.value， 操 作 步 又 如 下 : 

(1) 在 VBE 菜单 中 依次 选择 【调试 】|【 添 加 监视 】 命 令 〈 如 图 1-16 所 示 ) 

(2) 在 【添加 监视 】 对 话 框 中 的 【表达 式 】 文 本 框 中 输入 Selection.value。 

(3) 在 【监视 类 型 】 选 项 组 中 选中 【监视 表达 式 】 单 选 按 钮 ， 然 后 单 击 【 确 定 】 按 钮 。 

此 时 ， 在 监视 窗口 中 即 会 显示 所 添加 的 监视 表达 式 Selection.value， 以 及 相应 的 当前 值 、 
类 型 等 信息 ， 如 图 1-17 所 示 。 


Ti | 
es 


YhAProject 


三 当 些 视 值 为 真 时 中 断 了 [) 
三 当 监视 值 改变 时 中 断 C) 


图 1-16 添加 监视 图 1-17 监视 窗口 


在 【添加 监视 】 对 话 框 中 可 以 设置 监视 的 类 型 。 监 视 类 型 包括 监视 表达 式 〈 默 认 ) 、 当 
监视 值 为 真 时 中 断 、 当 监视 值 改变 时 中 断 。 后 两 种 可 以 设置 监视 断 点 ， 当 所 监视 的 表达 式 为 
真 或 者 改变 的 情况 下 中 断 程序 的 执行 ， 以 利 调试 。 


1.4 从 宏 开 始 学 习 VBA 


使 用 Excel 2007 VBA 做 应 用 开发 时 ， 一 个 比较 实用 的 功能 之 一 就 是 宏 。 通 常 当 对 一 个 应 
用 做 过 分 析 后 ， 可 以 发 现 有 部 分 代码 是 可 以 通过 录制 宏 来 获取 的 。 适 用 宏 的 情况 很 多 ， 如 所 
编写 的 应 用 经 常 涉及 到 单元 格格 式 设置 以 及 大 量 的 Excel 本 身 内 置 功能 的 调用 时 。 例如 自动 篇 
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选 、 高 级 筛选 、 排 序 、 数 据 透视 表 等 。 采 用 首先 录制 宏 然后 修改 代码 的 方式 可 以 大 幅度 减轻 
开发 的 工作 量 ， 缩 短 开发 的 周期 。 


宏 是 存储 了 一 系列 命令 的 程序 。 当 创建 一 个 宏 命 令 时 ， 只 是 将 一 系列 的 键盘 输入 组 合 
一 个 简单 的 命令 。 这 些 命令 的 组 合 在 以 后 可 以 被 重复 “ 回 演 ”。 使 用 宏 命 令 可 以 减少 复杂 任 
务 的 步骤 ， 可 以 显著 地 减少 花 在 创建 、 设 置 格式 、 修 改 和 打印 工作 表 的 时 间 。 用 户 可 以 通过 
Excel 2007 内 置 的 录制 工具 来 创建 安 命令 ， 也 可 以 在 代码 编辑 器 里 面 直 接 书写 宏 代码 。 

通常 当 需 要 反复 地 做 一 些 动作 或 Excel 2007 没有 提供 一 个 内 置 工具 帮助 完成 某 个 任务 时 ， 
则 可 以 选择 创建 一 个 宏 。 宏 命令 能 够 将 工作 表 的 部 分 工作 自动 化 ， 例 如 创建 一 个 宏 命 令 去 自 
动 修改 工作 竹中 工作 表 的 标签 、 帮 助 检查 选中 的 工作 表 区 域 里 的 重复 值 、 快 速 地 将 某 种 单元 
格格 式 应 用 到 多 个 单元 格 区 域 等 。 

Excel 还 拥有 非常 强大 的 图 表 功 能 。 如 果 想 要 实现 图 表 创 建 和 格式 设置 自动 化 ， 使 用 宏 命 
令 一 样 行 之 有 效 。 宏 命令 还 可 以 帮助 设置 打印 区 域 、 页 边 距 、 页 眉 、 页 脚 以 及 选择 特殊 的 打 
印 选项 。 

调用 宏 的 方式 是 , 在 Excel 2007 的 菜单 中 依次 选择 【视图 】I【 宏 】 命 令 ( 如 图 1-18 所 示 ) ， 
然后 打开 下 拉 列 表 框 ， 随 后 在 弹出 的 宏 菜 单 ( 如 图 1-19 所 示 ) 中 选择 相应 的 操作 。 该 弹出 菜 


单 下 包含 了 3 个 菜单 选项 ， 查 看 宏 、 录 制 宏 和 使 用 相对 引用 。 
me! 
加 碍 看 去 W) 
四 录制 雪 B)-… 
安 国 合用 fx 引用 (WU 
图 1-18 宏 图 1-19 宏 菜 单 


口 查看 宏 : 选择 该 菜单 选项 后 将 打开 宏 管 理 窗口 。 在 该 窗口 中 可 以 完成 运行 、 编 辑 、 
创建 、 删 除 、 设 置 宏 选 项 等 宏 管理 工作 。 该 窗口 界面 如 图 1-20 所 示 。 


1-20” 宏 管理 窗口 


口 录制 宏 ， 选择 该 菜单 选项 后 ， 首 先 弹出 一 个 宏 设 置 窗口 (如 图 1-21 所 示 ) ， 在 该 窗 
口中 可 以 设置 录制 宏 的 名 称 以 及 快捷 键 。 单 击 【 确 定 】 按 钮 后 即 开始 录制 宏 。 此 时 
在 Excel 2007 的 状态 栏 上 出 现 【 停 止 录制 宏 】 按 钮 (如 图 1-22 所 示 ) 。 当 录制 完成 
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后 ， 单 击 该 按钮 即 可 终止 录制 宏 。 


EE 3 
宏 名 加: 
[En 
快捷 键 开 ): 

cen 
保存 在 中; 
ii | “可 
I N 

Cm | ws | 和 
图 1-21 宏 设 置 窗口 图 1-22 停止 录制 


1.4.2 录制 宏 实例 


在 创建 一 个 宏 命 令 之 前 ， 需 要 考虑 究 竞 需要 做 什么 。 宏 命令 是 一 大 堆 键盘 输入 的 集合 ， 
事先 计划 好 所 有 动作 非常 重要 。 如 果 在 录制 宏 之 前 ， 没 有 很 好 地 计划 ， 将 会 录制 很 多 不 必要 
的 步骤 。 这 些 元 余 的 步骤 将 会 影响 宏 的 运行 速度 ， 也 会 给 开发 者 编辑 修改 宏 造成 一 定 的 不 便 。 

笔者 的 建议 是 : 在 建立 宏 时 ， 首 先 手 动 将 宏 命令 需要 做 的 事务 演练 一 遍 ， 同 时 ， 记 录 下 
每 一 步 实际 发 生 的 动作 ， 越 精简 越 好 ， 最 后 开始 录制 该 宏 并 按照 自己 记录 的 步骤 操作 ， 减 少 
宏 代 码 元 余 与 操作 错误 带 来 的 麻烦 。 


F 面 是 一 个 录制 宏 的 实例 ， 该 实例 将 学 生 表 的 A 列 (学 ai 
生 名 列 ) 的 不 重复 项 目 筛选 出 来 ， 然 后 填充 到 该 表 的 C 列 。 i 
被 记录 下 来 的 操作 步骤 如 下 : 


(1) 在 菜单 中 选择 【工具 】|【 宏 】| 【录制 新 宏 】 命令 。 
(2) 选择 “学 生 ” 表 的 A 列 。 
(3) 在 菜单 中 选择 【数据 】| 【筛选 】|【 高 级 筛选 】 命 
令 ， 单 击 该 按钮 后 ， 将 打开 【高 级 筛选 】 对 话 框 ， 具 体 的 设 。 图 1-23 【高 级 筛选 】 对 话 框 
置 如 图 1-23 所 示 。 
该 宏 的 代码 如 下 : 
Sub Macro1() 


"Macro1 Macro 
' 宏 由 Alex 录制 ， 时 间 : 2007-9-8 


Columns("A:A").Select ' 选 择 入 列 
Range("A1:A22").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ 
"C1"), Unique:=True ' 筛 选 A 列 不 重复 记录 到 C 列 


'Action 参数 ， 指 定 是 否 就 地 复制 或 筛选 列表 

'CopyToRange 参数 : 如 果 Action 为 xIFilterCopy， 则 为 复制 行 的 目标 区 域 ， 否 则 ， 忽 略 该 参数 
'Unique 参数 : 如 果 为 True， 则 只 筛选 唯一 记录 。 如 果 为 False， 则 筛选 符合 条 件 的 所 有 记录 。 默 认 值 
为 False 

End Sub 


代码 说 明 : 


， 


办 公 应 用 章 党 之 禾 
Excel VBA 应 用 开发 经 典 案例 

该 代码 中 用 到 的 AdvancedFilter 方法 可 以 基于 条 件 区 域 从 列表 中 筛选 或 复制 数据 。 如 果 初 
始 选 定 区 域 为 单个 单元 格 ， 则 使 用 单元 格 的 当前 区 域 。 该 方法 的 各 个 参数 的 意义 请 参见 本 章 
的 知识 点 。 


1.4.3 ”分析 与 编辑 宏 代 码 


大 多 数 情况 下 通过 录制 宏 得 到 的 代码 通常 是 不 适合 被 直接 应 用 的 ， 其 中 存在 很 多 元 余 的 
代码 。 这 些 元 余 的 代码 通常 会 增加 程序 的 运行 时 间 。 为 了 提高 程序 的 运行 速度 与 效率 ， 降 低 
维护 难度 ， 对 录制 宏 得 到 的 代码 加 以 修改 后 使 用 很 有 实际 意义 。 

在 上 述 录 制 的 宏 代码 中 ， 选 择 A 列 的 语句 就 是 多 余 的 。 这 是 因为 后 续 的 高 级 筛选 代码 中 
指定 了 筛选 的 范围 Range("A1:A22")， 因 此 无 须 再 另行 指定 选择 范围 。 另 外 其 中 的 注释 也 没有 
必要 ， 因 而 这 段 代码 可 以 修改 为 如 下 代码 : 

Sub Macro1() 

Range("A1:A22").AdvancedFilter Action:=xlIFilterCopy, CopyToRange:=Range( _ 
"C1"), Unique:=True "筛选 A 列 不 重复 记录 到 C 列 

End Sub 

除了 代码 中 多 余 的 注释 与 区 域 选择 代码 可 以 删除 外 ， 方 法 中 有 默认 值 的 参数 选项 也 可 以 
去 除 。 另 外 ， 很 多 通过 录制 宏 获取 的 代码 实际 上 可 以 将 几 步 合并 到 一 步 中 。 这 样 的 情况 既 可 
以 精简 代码 、 增 强 可 阅读 性 ， 还 可 以 提高 程序 的 运行 速度 。 例 如 录制 复制 /粘贴 操作 时 ， 录 制 
的 代码 类 似 以 下 代码 : 


Range("A1").Select ' 选 择 A1 单元 格 
Selection.Copy "复制 A1 单元 格 
Range("F1").Select "选择 F1 单元 格 
ActiveSheet.Paste "粘贴 A1 单元 格 数据 格式 到 F1 单元 格 
这 4 行 代 码 实际 上 可 以 使 用 以 下 一 行 代码 来 完成 : 
Range("A1").Copy Destination:=Range("F1") ' 粘 贴 A1 单元 格 数据 格式 到 F1 单元 格 
当 对 同一 个 对 象 执行 多 个 操作 时 ， 可 以 使 用 With…End With 结构 ， 例 如 以 下 代码 : 
Range("A14:G14").Select "选择 A14:G14 单元 格 区 域 
Selection.Font.Bold=True "设置 字体 加 粗 
Selection.Font.Size=12 "定义 字体 大 小 
Selection.Font.ColorIndex=5 "定义 文字 颜色 
Selection.Font.Underline=xlUnderlineStyleDoubleAccounting “' 定 义 下 划 线 样式 
以 上 代码 可 以 换 成 : 
With Range("A14:G14").Font 

.Bold=True 

.Size=12 

.ColorlIndex=5 

. Underline=xlUnderlineStyleDoubleAccounting 
End With 
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要 运行 宏 , 可 以 使 用 在 录制 宏 时 设置 的 快捷 键 ; 也 可 以 打开 宏 管理 窗口 (如 图 1-20 所 示 )， 
从 中 选择 需要 运行 的 宏 ， 然 后 选择 【运行 】; 还 可 以 在 VBE 环境 下 打开 该 宏 过 程 ， 然 后 单 击 
VBA 编辑 器 工具 栏 〈 如 图 1-6 所 示 ) 中 的 【运行 程序 】 按 钮 。 在 该 环境 中 ， 可 以 逐 行 执行 宏 
过 程 的 代码 。 当 读者 无 法 读 伐 宏 过 程 代码 的 意义 时 ， 可 以 采用 逐 行 执行 方式 ， 检 查 每 一 步 宏 
过 程 的 运行 情况 。 


A 


第 2 章 VBA 程序 设计 基础 


本 章 也 是 基础 章节 ， 重 点 讲解 VBA 程序 设计 的 基础 知识 。 本 章 依 次 讲解 VBA 各 部 分 的 
基础 ， 包 括 数 据 类 型 、 常 量 、 变 量 、 过 程 与 函数 、 运 算 符 、 结 构 语 句 、 常 用 函数 和 数组 。 如 
果 读 者 对 这 些 内 容 已 经 有 了 较 深 的 认识 ， 可 以 跳 过 本 章 阅读 后 续 实 例 章节 。 


2.1 数据 类 型 


数据 类 型 决定 了 数据 在 计算 机 中 的 存储 方式 以 及 程序 对 该 种 类 型 数据 所 能 做 的 操作 。 数 
据 类 型 不 同 则 其 在 内 存 中 的 存储 结构 不 同 ， pi VBA 提供 的 基本 数据 类 型 主要 
有 数值 型 、 字 节 型 、 字 符 串 型 、 迪 辑 型 、 日 期 型 、 无 符号 型 、 变 体型 、 对 象 型 等 类 型 。 如 果 
没有 定义 变量 的 数据 类 型 ，VBA 将 自动 设置 ad CVariant) 。Variant 
型 有 能 力 解 决 数据 本 身 的 操作 类 型 并 且 使 用 该 类 型 。 表 2-1 中 列 出 了 VBA 支持 的 所 有 数据 


表 2-1 VBA 基本 数据 类 型 


数据 类 型 (名称) 大 小 ( 字 节 ) 描 述 
Boolean 逻辑 值 True 或 False 
Byte 1 0 到 255 的 整数 
Integer 2 -32768~32767 的 整数 
Long 4 -2147483648~2147483647 的 整数 
单 精度 浮 点 数值 
Single 4 负数 : -3.402823E38~-1.401298E-45 
正 数 : 1.401298E-45~3.402823E38 
双 精 度 浮 点 数值 
Double 8 负数 : -1.79769313486231E308~--4.94065645841247E-324 


正 数 : 4.94065645841247E-324~1.79769313486231E308 


(放大 的 整数 〈 作 者 : 整数 除 以 10000 得 到 的 数值 ， 参 见 
Currency 8 VBA 帮助 )) 使 用 在 定点 计算 中 : 
-922337203685477.5808~922337203685477.5807 


+/-79228162514264337593543950335 没有 小 数 点 ; 
+/-7.9228162514264337593543950335 小 数 点 后 有 28 位 数字 ; 
最 小 的 非 0 数字 是 

+/-0.0000000000000000000000000001 


Decimal 14 


Date 8 从 100 年 1 月 1 日 到 9999 年 12 月 31 日 的 日 期 


wh 
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10 字 节 + 字 符 串 长 度 | 变 长 字符 串 最 多 可 包含 大 约 20 亿 (2^31) 个 字符 


数据 类 型 (名 称 ) 
String( 变 长 字符 串 ) 


Object 对 象 变量 用 来 引用 Excel 中 的 任何 对 象 
Variant ( 带 数 字 ) |16 最 高 范围 到 Double 类 型 的 任何 数值 
Variant ( 带 字母 ) | 22 字 节 + 字符 串 长 度 | 和 变 长 字符 串 的 范围 一 样 


每 个 成 员 的 范围 和 其 数据 类 型 的 范围 一 致 


户 定义 类 型 (使 用 Type) | 成 员 所 需 的 数值 


VBA 除了 基本 数据 类 型 之 外 ， 还 可 以 由 用 户 定义 自己 的 数据 类 型 。 不 同 的 数据 类 型 占据 
电脑 内 存 的 空间 是 不 一 样 的 。 为 了 保存 内 存 并 确保 程序 运行 更 快 ， 应 该 选择 占用 字 节 最 少 的 、 
同时 又 能 处 理 当 前 数据 的 数据 类 型 。 


2.1.1 数值 型 


VBA 的 数值 型 类 型 包括 整 型 (Integer) 、 长 整 型 (Long) 、 单 精度 浮 点 型 (Single) 、 
Double〈 双 精度 浮 点 型 ) 和 货币 型 (Currency) 。 

1. 整 型 (Integer) 

用 于 表示 -32768~32767 之 间 的 整数 。 存 储 该 类 型 数据 占用 2 〈16 位 ) 个 字 节 空间 ， 其 运 
算 速度 较 快 。 定 义 该 类 型 变量 时 ， 可 以 使 用 以 下 两 种 方式 ， 其 中 第 二 种 方式 使 用 了 类 型 声明 
符 “%”。 


Dim rowsCount as Integer 
Dim rowsCount% 


2. 长 整 型 (Long) 

用 于 表示 -2147483648~2147483647 之 间 的 整数 。 存 储 该 类 型 数据 需要 占用 4 个 字 节 。 长 
整 型 (Long) 的 类 型 声明 符 是 “&”。 

3. 单 精度 浮 点 型 《Single) 

用 于 表示 带 小 数 的 实 型 数 ， 有 效 位 为 7 位 。 存 储 该 数据 类 型 占用 4 个 字 节 。 单 精度 浮 点 
型 (Single) 的 类 型 声明 符 是 “!”。 一 般 以 科学 计数 法 表示 ， 其 中 指数 部 分 以 “E” 或 “e” 表 
示 。 其 科学 计数 法 表现 形式 举例 如 下 : 

4.55E+14 表示 4.55x10!4，3.69e-7 表示 3.69x10 "。 

4. 双 精 度 浮 点 型 (Double) 

同音 精度 浮 点 型 ， 也 表示 带 小 数 的 实 型 数 ， 有 效 位 为 15 位 。 存 储 该 数据 类 型 需要 占用 8 
个 字 节 。 双 精度 浮 点 型 (Double) 的 类 型 声明 符 是 “#”。 其 科学 计数 法 用 “D ”或 “d” 表 示 
指数 部 分 。 

5. 货币 型 (Currency) 

用 于 货币 计算 。 该 数据 类 型 支持 19 位 有 效 数 字 ， 其 中 小 数 点 右面 占用 4 位 有 效 数 。 货 币 
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型 (Currency) 的 类 型 声明 符 是 “@” 


2.1.2” 字 节 型 (Byte) 


字 节 数据 类 型 用 1 字 节 存储 0~255 间 的 无 符号 单 精度 整 型 数值 。 如 果 变 量 用 于 二 进 制 运 
算 ， 应 该 声明 为 Byte 数据 类 型 数组 。 


2.1.3 字符 串 型 (String ) 


字符 串 类 型 用 于 存储 字符 序列 的 数据 类 型 ， 其 定 界 符 为 一 对 美文 双 引 号 。 在 VBA 中 字符 
串 分 为 两 种 : 变 长 和 定 长 字符 串 。 字 符 串 类 型 的 类 型 声明 符 是 “$ 

定 长 字符 串 的 定义 方式 如 下 : 

Dim rowsCount As String * 200 


2.1.4 ”逻辑 型 (Boolean) 


当 数 据 只 需要 记录 两 种 相反 的 状态 信息 时 ， 该 数据 类 型 的 数据 占用 2 个 字 节 。 如 表示 
“True/False”、“Yes/No” 等 ， 应 该 选择 使 用 逻辑 型 (Boolean) 。 其 默认 值 为 False。 


2.1.5 日 期 型 (Date) 


日 期 型 用 于 记录 时 间 和 日 期 数据 。 在 VBA 中 日 期 数据 类 型 的 定 界 符 为 “#”。 下 面 是 一 
# 月 /日 /年 #: 例如 #10/23/2007# 表 示 2007 年 10 月 23 号 。 

# 年 -月 -日 #: 例如 #2004-1-29# 表 示 2004 年 1 月 29 号 。 

# 年 ， 月 ， 日 #: 例如 #1995,6,29# 表 示 1995 年 6 月 29 号 。 

# 英 文 月 份 缩写 日 ， 年 #: 例如 交 uly 5,1998# 表 示 1998 年 7 月 5 号 。 

# 时 :分 : 秒 AM/PM#: 例如 #10:30:54 AM# 表 示 上 午 10 点 30 分 54 秒 。 

# 月 /日 /年 时 :分 : 秒 AM/PM#: 该 格式 是 时 间 与 日 期 两 部 分 的 结合 。 


将 
DDOOOOO 室 


D 
mh 
O) 


无 符号 型 (Decimal) 


无 符号 类 型 (Decimal) ， 该 种 数据 类 型 存储 96 位 〈12 个 字 节 ) 无 符号 的 整数 形式 ， 并 除 
以 一 个 10 的 寡 数 , 称 为 变 比 因子 。 这 个 变 比 因子 决定 了 小 数 点 右面 的 数字 位 数 , 其 范围 为 0~28。 
变 比 因 子 为 0〈 没 有 小 数位 ) 的 情形 下 ， 最 大 的 可 能 值 为 +/-79228162514264337593543950335 。 
而 在 有 28 个 小 数位 的 情况 下 ， 最 大 值 为 +/-7.9228162514264337593543950335， 而 最 小 的 非 零 
值 为 +/-0.0000000000000000000000000001。 
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Decimal 数据 类 型 只 能 在 Variant 中 使 用 ， 也 就 是 说 ， 不 能 声明 一 变量 为 Decimal 类 型 。 
不 过 可 以 用 Cdec 函数 创建 一 个 子 类 型 为 Decimal 的 Variant。 


2.1.7 ” 变 体型 (Variant) 


所 有 没有 被 显示 声明 其 数据 类 型 的 变量 ，VBA 都 将 其 作为 变 体型 (Variant) 处 理 。 系 统 
将 会 自动 判断 保存 数据 的 类 型 。 另 外 ， 该 数据 类 型 还 包含 了 Empty、Null 和 Error 3 个 特殊 值 。 

口 “Empty 值 : 当 Variant 数据 类 型 没有 被 初始 化 前 ， 其 值 为 Empty。 该 值 不 等 价 于 0、 
零 长 度 字符 串 或 Null 值 。 

口 Null 值 ， 指定 变量 不 含有 效 值 ， 通 常 表示 未 知 数据 或 丢失 数据 。 

口 ”Error 值 : 用 于 指示 在 过 程 中 出 现 错误 时 的 特殊 值 。 与 其 他 类 型 错误 不 同 ， 这 些 错误 
并 非 发 生 正常 的 应 用 程序 级 的 错误 处 理 ， 因 此 ， 可 以 根据 Error 值 对 类 型 错误 进行 
取舍 。 


2.1.8 ”对象 型 (Object) 
对 象 类 型 (Object) 用 来 表示 图 形 、OLE 对 象 或 其 他 对 象 ， 用 4 个 字 节 存 储 。 
2.1.9 用 户 自 定义 型 


用 户 自 定义 型 用 于 建立 满足 用 户 特殊 需求 的 自 定义 数据 类 型 ， 该 数据 类 型 由 多 个 基本 数 
据 类 型 的 数据 组 成 。 定 义 自 定义 数据 类 型 采用 Type 语句 。 一 般 的 格式 如 下 : 
Type 自 定 义 数 据 类 型 名 称 


元 素 1 名 称 As 数据 类 型 
元 素 2 名 称 As 数据 类 型 


元 素 N 名 称 As 数据 类 型 
End Type 


在 程序 执行 前 值 已 经 确定 ， 且 执行 过 程 中 不 能 改变 的 量 称 为 常量 。VBA 中 的 常量 包括 直 
接 常 量 、 符 号 常量 和 系统 常量 。 
2.2.1 直接 常量 


量 、 日 期 /时 


部 
tt 
沉 
如 
中 
应 
部 
内 
会 
部 
站 
人 
策 
Ed 
部 


程序 代码 中 直接 书写 的 量 就 是 直接 常 
间 常 量 和 布尔 常量 。 
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Excel VBA 应 用 开发 经 典 案例 


1. 数值 常量 

数值 常量 是 直接 以 数字 体现 的 数值 型 数据 。 在 VBA 中 可 以 使 用 类 型 标识 符 表示 常量 的 数 
据 类 型 (各 种 数值 型 数据 的 类 型 标识 符 参 见 2.1.1 节 具 体 说 明 ) 。 例 如 : 8.75# 表 示 的 是 一 个 双 
精度 数值 。 

2. 字符 串 常 量 

字符 串 常量 可 以 包括 数字 、 英 文字 母 、 特 殊 符 号 和 汉字 等 可 打印 字符 。 定 义 时 必须 用 双 
引号 加 以 标示 。 例 如 : 

“这 是 一 个 字符 串 常量 实例 ” 

如 果 字 符 串 常量 中 包括 了 双 引 号 ， 此 时 需要 在 有 双 引 号 的 地 方 输入 两 次 双 引 号 ， 例 如 : 

“货币 型 数据 类 型 的 类 型 声明 符 是 : "@""" ” 

其 中 1、6 双 引 号 用 于 界定 字符 串 常 量 ，2、5 双 引 号 用 于 界定 内 部 双 引 号 ，3、4 双 引 号 
是 字符 串 常 量 中 的 双 引 号 。 

3. 日 期 /时 间 常 量 

日 期 /时 间 常 量 是 直接 体现 的 日 期 型 数据 ， 书 写 的 格式 参见 日 期 型 数据 的 书写 方法 。 

4. 布尔 常量 

布尔 常量 是 直接 体现 的 布尔 型 数据 ， 书 写 的 格式 参见 布尔 型 数据 的 书写 方法 。 


2.2.2 ”符号 常量 


如 果 在 代码 中 需要 多 次 重复 使 用 某 一 个 常量 时 ， 应 当 命名 该 常量 。 这 样 做 一 方面 可 以 增 
强 程序 的 可 读 性 ， 另 一 方面 如 果 需 要 修改 常量 值 ， 可 以 快速 修改 ， 亦 可 降低 出 错 率 。 符 号 常 
量 必须 在 程序 开始 运行 前 被 定义 ， 并 且 在 程序 运行 中 ， 不 能 修改 和 重新 赋值 。 

符号 常量 的 定义 方式 如 下 : 

Const 符号 常量 名 称 = 符 号 常量 表达 式 

Const 是 定义 符号 常量 的 关键 字 。 定义 了 符号 常量 后 ,在 之 后 的 程序 代码 中 就 可 以 使 用 符号 
常量 名 称 来 引用 符号 常量 表达 式 的 值 。 通 常 定义 一 个 有 实际 意义 、 便 于 记忆 的 常量 名 ， 以 减轻 
工作 量 。 如 果 需 要 建立 全 局 性 的 符号 常量 ， 应 在 模块 声明 部 分 将 常量 声明 为 Public 型 。 例 如 : 

Public Const PI=3.14159265358979 

定义 符号 常量 时 ， 可 以 使 用 直接 常量 ， 也 可 以 使 用 计算 结果 为 数字 或 字符 串 的 表达 式 ， 
还 可 以 使 用 前 面 定义 过 的 符号 常量 。 例 如 : 

Public Const PI2=PI*PI 


2.2.3 ”系统 常量 


Excel 2007 VBA 提供 了 一 系列 用 于 各 种 用 途 的 符号 常量 ， 这 些 常量 统称 为 系统 常量 。 这 


_ 
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些 常 量 在 应 用 程序 对 象 的 方法 和 属性 中 使 用 。 这 些 常量 通常 都 以 xl、vb 开头 。 在 对 和 象 浏览 器 
中 可 以 通过 输入 xl、vb 获得 以 这 些 开 头 的 系统 常量 的 列表 ， 或 者 输入 具体 的 常量 名 称 查询 该 
常量 对 应 的 值 。 如 图 2-1 所 示 是 在 对 象 浏览 器 中 输入 vb 后 查看 vbMsgBoxResult 的 常量 成 员 时 
的 效果 图 。 


ETEEES 下 = 区 


图 2-1 查看 系统 常量 
2.3 变 量 


变量 是 一 个 用 来 引用 一 条 数据 的 量 。 通 常 在 程序 执行 过 程 中 ， 用 变量 存储 临时 数据 ， 其 
内 容 随 程序 的 执行 而 变化 。 变 量 可 以 被 看 作为 存放 未 知 值 的 内 存单 元 。 


2.3.1 变量 命名 


引用 变量 时 是 通过 变量 名 称 实现 的 。 变 量 名 称 里 可 以 包含 字母 、 数 字 和 一 些 标点 符号 ， 
但 不 包含 #$ % & @ ! 这 6 个 符号 。 命 名 时 需要 遵循 以 下 规则 : 

口 ”必须 以 字母 开头 ， 后 跟 字 母 、 数 字 或 下 划 线 ， 在 中 文 Excel 2007 VBA 中 还 允许 使 用 

汉字 。 

口 不 能 有 空格 或 使 用 类 型 声明 符 等 特殊 符号 。 

口 ”长度 不 能 超过 255 个 字符 。 控 件 、 窗 体 、 类 或 模块 的 名 字 不 能 超过 40 个 字符 。 

口 不 能 与 系统 关键 字 同 名 。 

VBA 的 变量 名 不 区 分 大 小 写 。 在 命名 时 通常 采取 统一 的 命名 规则 。 通 常 做 法 是 : 用 变量 
类 型 的 缩写 小 写字 母 做 前 级， 后 跟 首 字母 大 写 的 有 意义 的 名 称 。 例 如 : strName， 表 示 Name 
(姓名 ) 的 字符 串 变 量 ，intAge， 表 示 Age (年龄 的 整 型 变量 。 


全 注 意 : 关键 字 指 在 VBA 中 有 特殊 意义 的 单词 或 单词 的 缩写 ， 如 Public、Sub 等 。 


让 


在 使 用 变量 之 前 ， 一 般 先 对 该 变量 加 以 声明 ， 告 知 VBA 该 变量 的 数据 类 型 其 占用 的 存储 


空间 。 声 明 变 量 的 方法 如 下 : 

Dim 变量 名 称 [As 数据 类 型 ] 

Dim 和 As 是 声明 变量 的 关键 字 。 中 括号 所 标识 的 是 可 以 省 略 的 部 分 ， 即 变量 的 数据 类 型 
可 以 不 指定 。 在 VBA 中 ， 声 明 变量 包括 隐 式 声明 和 显 式 声明 两 种 方式 。 以 下 是 这 两 种 方式 的 
详细 介绍 : 

1. 隐 式 声明 

在 使 用 一 个 变量 之 前 没有 对 该 变量 进行 声明 ， 这 种 变量 的 声明 方式 即 为 隐 式 声明 。 此 时 ， 
VBA 会 自动 创建 该 变量 , 并 将 其 类 型 设置 为 Variant 类 型 , 此 时 其 值 为 Empty。 当 其 被 赋值 后 ， 
该 值 的 数据 类 型 将 替代 该 变量 的 数据 类 型 。 

隐 式 声明 变量 并 不 是 良好 的 编程 习惯 。 程 序 中 大 量 使 用 未 被 声明 的 变量 ， 经 常 造成 不 必 
要 的 错误 ， 加 大 程序 维护 与 调试 难度 ， 也 不 便于 阅读 。 例 如 变量 的 拼写 错误 ， 这 些 错误 通常 
不 能 被 编译 系统 检查 出 来 。 

2， 显 式 声明 

变量 使 用 Dim 关键 字 加 以 声明 ， 即 为 显 式 声明 。 为 了 避免 隐 式 声明 带 来 的 麻烦 ， 可 以 设 
置 为 当 遇 到 未 声明 变量 时 VBE 提示 错误 警告 。 方 法 参见 1.2.1 节 关 于 VBE 环境 的 设置 的 具体 
说 明 。 


2.3.3 ”变量 的 作用 范围 


变量 能 够 发 生 作用 的 范围 即 变量 的 作用 范围 。 通 常 按照 其 作用 范围 可 以 把 变量 划分 为 局 
部 变量 、 模 块 变量 、 全 局 变量 和 静态 变量 。 

1. 局 部 变量 

在 过 程 的 内 部 被 声明 的 变量 即 为 局 部 变量 。 该 变量 只 能 在 其 被 声明 的 过 程 中 有 效 。 通 常 

过 程 中 临时 使 用 的 变量 声明 为 局 部 变量 。 这 样 不 同 过 程 中 类 似 的 变量 就 可 以 采用 相同 的 变 
ent op etter ttt etn 

2. 模块 变量 

在 模块 的 顶部 声明 的 变量 即 为 模块 变量 。 该 变量 在 该 模块 的 所 有 过 程 中 都 是 有 效 的 ， 但 
在 其 他 模块 中 不 能 被 引用 。 
全 注意 : 当 模 块 变量 与 该 模块 中 菜 个 过 程 的 局 部 变量 同名 时 ， 该 过 程 中 出 现 的 变量 名 称 引用 

的 是 局 部 变量 ， 而 非 模块 变量 。 


< 
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3. 全 局 变量 

使 用 Public 关键 字 在 模块 中 声明 的 变量 即 为 全 局 变量 。 该 变量 在 所 有 模块 中 有 效 ， 程 序 
中 所 有 过 程 都 可 以 访问 该 变量 。 

当 变 量 在 程序 中 的 多 个 模块 中 共享 时 ， 需 要 将 其 声明 为 全 局 变量 。 如 果 变 量 需 要 在 同一 
模块 的 多 个 过 程 中 共享 时 ， 应 当 声 明 为 模块 变量 。 尽 量 多 地 使 用 局 部 变量 ， 在 必要 的 情况 下 
使 用 全 局 变量 和 局 部 变量 ， 以 减少 程序 的 开销 以 及 出 错 几率 。 

各 注意 : 不 能 在 过 程 中 声明 全 局 变量 ， 只 能 在 模块 的 声明 部 分 声明 全 局 变量 。 

4. 静态 变量 

对 于 一 般 的 局 部 变量 ， 当 包含 该 变量 的 过 程 执行 完毕 后 ， 该 变量 的 值 将 不 会 继续 存在 ， 
其 占用 的 内 存 也 将 被 系统 释放 。 下 一 次 执行 该 过 程 时 ， 系 统 将 会 给 该 局 部 变量 重新 分 配 内 存 
单元 并 进行 初始 化 。 

但 是 有 时 候 ， 需 要 过 程 中 的 局 部 变量 具有 记忆 能 力 。 当 过 程 结 束 后 ， 我 们 希望 该 变量 的 
值 能 够 继续 保存 下 去 。 例 如 有 某 个 按钮 ， 现 在 希望 该 按钮 被 按 奇 数 次 时 完成 与 被 按 偶 数 次 时 
不 同 的 任务 ， 这 个 时 候 就 需要 使 用 静态 变量 。 

当局 部 变量 被 定义 为 静态 变量 后 ， 就 可 以 在 退出 过 程 时 保存 该 变量 的 值 ， 以 供 再 次 调用 
该 数据 。 静 态 变量 的 定义 格式 如 下 

Static intClickCount As Integer 

下 面 是 一 个 静态 变量 使 用 的 实例 。 该 实例 对 双击 表 Sheetl 的 Al 单元 格 的 次 数 做 统计 。 当 
双击 偶数 次 时 ， 设 置 Al 单元 格 无 填充 ， 双 击 奇数 次 时 设置 Al 单元 格 为 红色 填充 色 。 

Sheetl 双击 事件 代码 如 下 : 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 


If Target.Row = 1And Target.Column = 1Then "检测 是 否 双 击 A1 单元 格 

ClickCount "双击 A1 单元 格 时 执行 ClickCount 过 程 
End If 
End Sub 


ClickCount 过 程 代码 如 下 : 
Sub ClickCount() 


Static intClickCount As Integer ' 定 义 静态 局 部 变量 保存 双击 次 数 
intClickCount = intClickCount + 1 "累计 双击 次 数 
IfintClickCount Mod 2 Then 

Sheet1.Range("A1").Interior.Color = RGB(255, 0, 0) "如 果 双 击 奇数 次 设置 红色 填充 色 
Else 

Sheet1.Range("A1").Interior.Pattern = xINone ' 如 果 双 击 偶数 次 清除 填充 格式 
End If 
MsgBox "您 已 双击 A1 单元 格 " & intClickCount & "次 !" "给 予 双击 次 数 提示 信息 
End Sub 
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2.4 认识 过 程 与 函数 


过 程 是 模块 中 最 小 的 单元 ， 通 常用 于 完成 某 个 相对 独立 的 功能 。 使 用 过 程 可 以 增强 程序 
的 结构 性 ， 使 程序 的 流程 更 加 清晰 ， 也 利于 程序 的 维护 和 升级 。VBA 中 常用 的 过 程 包括 Sub 
过 程 和 Function 函数 ， 下 面 分 别 介绍 这 两 个 过 程 类 型 。 


2.4.1 Sub 过程 


Sub 过 程 是 没有 任何 返回 值 的 一 段 程 序 ，Sub 过 程 又 被 称 为 子 过 程 。 通 常 Sub 过 程 用 于 完 
成 一 个 独立 的 、 明 确 的 任务 。 在 VBA 中 响应 事件 的 代码 块 都 是 Sub 过 程 。 
Sub 过 程 定义 格式 如 下 : 
[Private|Public] [Static] 过 程 名 称 ([ByVallByRef 参数 名 称 As 参数 类 型 ]) 
局 部 变量 声名 
过 程 代码 
End Sub 


1，Private|Public 关键 字 

将 过 程 声明 为 公共 过 程 或 者 私有 过 程 。 当 被 声明 为 Private 时 ， 只 有 在 包含 该 过 程 的 模块 
中 其 他 过 程 可 以 访问 或 调用 该 过 程 ， 当 被 声明 为 Public 时 ， 所 有 模块 的 所 有 过 程 都 可 以 调用 
这 个 过 程 。 

如 果 没 有 使 用 该 关键 字 ， 那 么 系统 将 默认 使 用 Public 设 定 该 过 程 。 

2. Static 关键 字 

当 将 过 程 声明 为 Static 后 ， 该 过 程 中 声明 的 所 有 局 部 变量 都 成 为 静态 变量 ， 所 有 变量 都 具 
有 了 记忆 能 力 。 该 关键 字 的 限定 作用 不 能 对 Sub 过 程 外 的 变量 起 作用 ， 包 括 那 些 在 该 过 程 中 
使 用 了 但 并 没有 在 该 过 程 中 声明 的 变量 。 

3. ByVallByRef 关键 字 

该 类 关键 字 限 定 参数 的 传递 方式 。ByRef 为 默认 参数 传递 方式 ,该 方式 传递 的 是 参数 的 引 
用 ， 过 程 用 变量 的 内 存 地 址 访问 实际 变量 的 值 ， 因 而 在 过 程 中 可 以 直接 修改 实际 变量 的 值 ; 
ByVal 指定 参数 按 值 传递 ,传递 的 是 变量 的 一 个 内 存 副本 , 过 程 中 对 该 副本 的 修改 不 会 影响 到 
人 各 注意 : 所 有 的 可 执行 代码 都 必须 处 于 某 个 过 程 中 ， 否 则 无 法 执行 。 不 能 在 过 程 或 函数 内 部 

定义 另外 的 过 程 。 

在 VBE 开发 环境 下 创建 过 程 可 以 采用 两 种 方法 。 

口 菜单 添加 过 程 

首先 在 【工程 资源 管理 器 】 窗 口中 双击 对 应 的 模块 ， 打 开 需 要 添加 过 程 的 模块 代码 编辑 


-~ 
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器 窗口 。 然 后 选择 【插入 】| 【过程 】 命令, 打开 【添加 过 程 】 男 

对 话 框 (如 图 2-2 所 示 )。 在 【名 称 】 文本 框 中 输入 过 程 名 称 。 等 V 所 一 [| 

后 单 击 确 定 按钮 ， 系 统 将 会 自动 生成 该 子 过 程 的 结构 。 cE 
如 果 生 成 的 过 程 需要 接收 参数 ， 则 在 【代码 编辑 器 】 窗 口 Ee 

中 过 程 名 后 的 括号 中 加 入 相应 的 参数 传递 方式 、 参 数 名 、 数 cas 

据 类 型 。 


厂 把 所 有 局 部 变量 声明 为 静态 变量 从) 


口 “代码 添加 过 程 
代码 添加 过 程 也 十 分 简便 。 添 加 过 程 时 ， 需 要 做 的 事情 图 2-2 【添加 过 程 】 对 话 杠 
是 在 代码 区 新 的 一 行 按 Sub 过 程 定义 格式 依次 输入 即 可 。 输 
入 完 过 程 的 反 括号 后 按 Enter 键 ，VBE 将 自动 添加 过 程 结束 语句 End Sub。 


2.4.2 ”Function 过 程 


Function 过 程 是 函数 过 程 ,简称 函数 。 函 数 用 于 建立 用 户 自 定义 函数 ， 自 定义 函数 的 调用 
和 Excel 2007 的 内 部 函数 调用 方法 一 致 。 其 与 Sub 过 程 类 似 的 是 ，Function 过 程 也 是 一 个 独立 
的 过 程 。 函 数 可 以 带 有 参数 列表 ， 执 行 一 系列 语句 ， 改 变 参数 的 值 ， 但 是 Function 过 程 可 以 
返回 一 个 值 作为 其 被 调用 的 结果 。 
定义 函数 过 程 的 语法 格式 如 下 : 
[Public|Private|Friend] [Static] 函数 名 称 ([ByVallByRef 参数 名 As 参数 数据 类 型 ]) As 返回 值 数据 类 型 
局 部 变量 声明 
函数 内 部 代码 
函数 结果 赋值 语句 
End Function 
函数 结果 赋值 语句 用 于 将 最 后 处 理 的 结果 赋值 给 函数 ， 这 个 结果 将 作为 函数 的 返 
Function 过 程 的 一 般 调用 方式 如 下 : 
函数 名 称 = 表达 式 
在 VBE 环境 下 ， 创 建 Function 过 程 和 Sub 过 程 的 创建 一 致 ， 不 同 的 是 在 “添加 过 程 ” 对 
话 框 中 ， 选 择 过 程 类 型 时 应 该 选中 【函数 】 单 选 按钮 。 


2.5 表达 式 与 运算 符 


表达 式 是 由 运算 符 和 操作 数 共同 组 成 的 合法 算式 。 操 作 数 可 以 是 常数 、 变 量 、 函 数 或 表 
达 式 。 运 算 符 是 连接 操作 数 的 运算 符号 。VBA 提供 了 5 种 类 型 的 运算 符号 : 算术 运算 符 、 比 
较 运算 符 、 风 辑 运算 符 、 连 接 运 算 符 和 特殊 运算 符 。 


办公 应 用 非 峰 之 禾 
Excel VBA 应 用 开发 经 典 案例 
2.5.1 算术 运算 符 

算术 表达 式 包括 基本 的 算术 运算 符号 。 这 些 运算 包括 加 减 乘除 、 指 数 运算 、 负 数 运算 、 


整除 与 取 模 运算 。 这 些 运算 间 存 在 运算 的 优先 级 ， 表 2-2 是 各 种 运算 符号 及 其 运算 优先 级 。 当 
需要 改变 运算 次 序 时 ， 可 以 使 用 圆 括号 改变 运算 的 优先 次 序 。 


表 2-2 算术 运算 符 及 其 优先 级 


算术 运算 符 描 述 实例 
^ 指数 运算 4^2 
- 负数 运算 -100，-200 
* 4*6-24 
/ 92-45 
\ 1014=25 
mod 7 mod 3=1,10 mod 4=2 
+ 5+3=8 
10-3-7 


2.5.2 ”比较 运算 符 


比较 运算 符 是 用 来 比较 两 个 数 或 表达 式 的 运算 符 ， 它 的 主要 作用 是 确定 比较 双方 的 关系 。 
运算 的 结果 可 分 为 True、False 和 Null, 只 要 运算 的 双方 中 有 任何 一 方 是 Null, 结果 还 是 Null。 
该 运算 符 又 叫 关 系 运算 符 。 表 2-3 列 出 了 各 个 比较 运算 符 及 其 功能 。 因 为 比较 运算 的 运算 优先 
级 别 一 致 ， 表 中 没有 列 出 优先 级 。 


表 2-3 比较 运算 符 及 其 功能 


比较 运算 符 实例 
= x=y 
<> X<C>: 
< 小 于 比较 x<y 
> 大 于 比较 x>y 
<= 小 于 等 于 比较 x<=y 
>= 大 于 等 于 比较 x>= 


2.5.3 ”逻辑 运算 符 


风 辑 运算 是 指 表达 式 间 的 逻辑 关系 运算 。 逻 辑 运算 符 通常 用 来 表示 比较 复杂 的 关系 ， 其 
最 终 运算 结果 只 可 能 是 True 或 False。 风 辑 运 算 符 具有 不 一 致 的 运算 优先 级 。 表 2-4 列 出 了 各 
个 逻辑 运算 符 以 及 其 运算 优先 级 。 


Ah 


表 2-4 逻辑 运算 符 及 其 优先 级 


取 反 运算 


AND 逻辑 与 运算 xANDy 
OR 逻辑 或 运算 xORy 


逻辑 异 或 运算 
逻辑 相等 运算 


表 2-5 体现 了 逻辑 运算 的 结果 。 该 表 假定 x 和 y 为 任意 两 个 操作 数 , 用 T 表示 风 辑 真 , 用 
F 表示 逻辑 假 。 


表 2-5 逻辑 运算 符 真 值 表 


2.5.4 ”连接 运算 符 


连接 运算 符 就 是 将 两 个 表达 式 连接 在 一 起 的 运算 符号 。 在 VBA 中 用 于 连接 的 运算 符 包括 
“+” 和 “&&”。“+” 主 要 用 于 连接 两 个 都 是 字符 串 的 情况 ，“&” 运 算 符 将 两 个 运算 数 强制 
转换 为 字符 串 后 连接 。 表 2-6 列 出 了 两 个 连接 运算 符 的 区 别 。 


表 2-6 & 与 + 连接 运算 差别 表 


操作 数 x & 连 接 的 结果 + 连接 的 结果 
2 | "1233" 抽 

123 "1233" 126 

aa 126 


“23 "123a3" 报错 
"hello" "World" "hello World" "hello World" 


2.5.5 ”特殊 运算 符 


VBA 提供 了 两 种 特殊 运算 符 : Is 和 Like， 它 们 应 属于 比较 运算 符 。 以 下 分 别 介 绍 这 两 个 
运算 符 的 使 用 方法 。 

1. Is 运算 符 

这 个 运算 符号 用 于 比较 两 个 对 象 变量 的 引用 变量 是 否 一 致 ， 返 


= 


结果 为 True 或 False。 使 


A 
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办 公 应 用 夸 党 之 多 


Excel VBA 应 用 开发 经 典 案例 


用 该 运算 符 的 语法 格式 如 下 : 
结果 = 对 象 1 ls 对 象 2 


如 果 对 象 变量 “对 象 1” 和 “对 象 2” 两 者 引用 相同 的 对 象 ， 则 结果 为 True; 否则 结果 为 
False。 以 下 是 该 运算 符 使 用 的 一 个 实例 : 
Dim MyObject, YourObject, ThisObject,OtherObject,ThatObject,MyCheck ' 定 义 变量 
A "给 变量 赋值 
Set YourObject=MyObject ' 指 定 对 象 引 用 
Set ThisObject=MyObject 
Set ThatObject=OtherObject "假设 MyObject<>OtherObject 
MyCheck=YourObject ls ThisObject ' 返 回 True 
MyCheck=ThatObject ls ThisObject ' 返 回 False 


2. Like 运算 符 


该 运算 符 把 一 个 字符 串 表 达 式 与 一 个 给 定 模式 〈SQL 表达 式 中 的 样式 ) 进行 匹配 。 匹 配 


成 功 返 回 结 果 True， 和 否则 返回 结果 False。 该 运算 符 主 要 用 于 数据 库 查 询 过 程 中 ， 
法 格式 如 下 : 
结果 = 字符 串 变量 Like 模式 


其 使 用 的 语 


如 果 字 符 串 变量 与 模式 表达 式 匹 配 ， 则 结果 为 Trme， 否 则 结果 为 False。 但 是 如 果 字 符 串 
变量 或 模式 中 有 一 个 为 Null 时 ， 则 结果 为 Null。Like 运算 符 内 建 的 模式 匹配 功能 提供 了 多 种 
方式 来 进行 字符 串 比 较 。 有 的 模式 匹配 功能 就 可 以 使 用 通配符 、 字 符 列表 或 字符 区 间 的 任何 


组 合 来 匹配 字符 串 。 表 2-7 列 出 了 常用 的 匹配 符号 。 
表 2-7 Like 运算 符 中 模式 设置 表 


模式 中 的 匹配 字符 字符 串 变量 中 相应 的 匹配 内 容 
? 任何 单一 字符 
零 个 或 多 个 字符 
并 任何 一 个 数字 〈0-9) 
字符 序列 字符 序列 中 的 任何 单一 字符 
[字符 序列 不 在 字符 序列 中 的 任何 单一 字符 


匹配 ， 这 个 集合 几乎 可 以 包括 所 有 字符 和 数字 。 
通过 在 范围 的 上 、 下 限 之 间 用 连 字 符 〈-) ， 字 符 列表 可 以 指定 字符 的 范围 。 


在 中 括号 〈[]) 中 ,可 以 用 由 一 个 或 多 个 字符 组 成 的 集合 与 字符 串 变量 中 的 任 一 字符 进行 


例如 ， 如 果 


字符 串 变量 中 相应 字符 的 位 置 包括 A~Z 之 间 的 任意 大 写字 母 ， 则 [A-Z] 得 到 一 个 匹配 模式 。 不 


需要 分 界 符 的 情况 下 ， 方 括号 内 就 可 以 包括 多 个 范围 。 


2.6 结构 语句 


VBA 的 过 程 大 部 分 不 会 一 行 一 行 从 开始 执行 到 末尾 。 经 常 需要 在 执行 过 程 中 


P 跳 转 到 过 程 


-~ 


第 2 章 VBA 程序 现 gt Bu 人 WO 


中 的 其 他 语句 ， 以 便 控制 程序 的 流程 。 比 如 有 些 过程 中 需要 通过 检测 某 个 变量 ， 然 后 再 决定 
下 一 步 应 该 执行 哪 一 部 分 语句 。 此 时 就 需要 使 用 If 结构 语句 调整 程序 的 运行 结构 ， 使 程序 的 
执行 流程 符合 实际 目的 。 

本 节 讲 解 的 结构 控制 语句 包括 : 赋值 语句 、 输 出 语句 、If…Then 语句 、If…Then*…Else 语 
句 及 其 变 体 、Select Case 多 分 支 结构 语句 、Do…Loop 循环 语句 、For…Next 语句 、For Each… 
Next 语句 和 跳 转 语句 。 


2.6.1 赋值 语句 


赋值 语句 是 将 表达 式 的 结果 赋 给 变量 的 语句 。 赋 值 语句 的 格式 如 下 : 

[Let] 变量 名 = 表达 式 

其 中 Let 关键 字 可 以 省 略 。 使 用 该 方式 赋值 时 需要 注意 以 下 几 点 : 

口 此 处 的 “=” 并 不 是 比较 运算 符 ， 其 意义 并 不 是 “等 于 ”， 只 起 赋值 操作 ， 其 左边 只 
能 是 变量 ， 不 能 使 用 表达 式 。 

口 变量 的 数据 类 型 必须 与 右边 表达 式 最 终 计算 结 果 数 据 的 数据 类 型 兼容 ， 否 则 不 能 完 
成 赋值 操作 。 例 如 : 


Dim intCount as integer 
intCount= "表达 式 " 


此 处 第 二 句 的 赋值 操作 是 错误 的 ， 因 为 该 语句 将 字符 串 数据 赋值 给 了 整 型 数据 。 
2.6.2 ”输出 语句 


在 Excel VBA 中 输出 时 可 以 将 结果 直接 输出 到 Excel 工作 表 中 ， 也 可 以 将 结果 使 用 
Debug.Print 输出 到 立即 窗口 中 。 通 常 输出 到 立即 窗口 中 可 以 便于 调试 ， 该 语句 在 单 步调 试 模 
式 中 也 可 以 查询 当前 内 存 变量 的 数据 值 ， 以 便于 调试 。 输 出 到 Excel 工作 表 的 方法 后 面 章节 有 
具体 介绍 。 输 出 到 立即 窗口 的 语句 格式 如 下 : 

Debug.Print [表达 式 ] [分 隔 符 ] 


Debug.Print 计算 表达 式 的 值 ， 然 后 将 其 值 输出 到 立即 窗口 中 。 有 多 个 表达 式 时 ， 使 用 分 
隔 符 分 隔 开 多 个 表达 式 。 以 下 是 各 种 分 隔 符 的 形式 : 
Spc(n): 在 输出 表达 式 的 结果 数据 间 插 入 n 个 空格 。 
Tab(n): 在 输出 表达 式 的 结果 数据 间 插 入 n 个 制 表 符 。 
分 号 : 将 多 个 输出 表达 式 的 结果 数据 用 分 号 连接 后 输出 。 
逗号 : 以 14 个 字符 为 一 个 输出 单元 , 每 个 表达 式 的 结果 数据 输出 到 对 应 的 输出 单元 内 。 


DOODoO 


2.6.3 | 上 f…Then 语句 


Jf…Then 语句 用 于 有 条 件 地 执行 一 条 或 一 段 语 句 ,If…Then 语句 是 典型 的 分 支 结 构 语句 之 
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办 公 应 用 非常 之 狗 


Excel VBA 应 用 开发 经 典 案例 


一 。 该 语句 有 两 种 语法 格式 。 

1. 单行 条 件 结构 语句 

单行 条 件 结构 语句 的 格式 如 下 : 

lf 逻辑 表达 式 Then 语句 

逻辑 表达 式 可 以 是 任何 计算 数值 的 表达 式 。VBA 将 以 True 或 False 表示 该 逻辑 表达 式 的 
计算 结果 ， 对 于 非 零 值 都 被 看 作 True， 而 为 零 的 表达 式 被 看 作 False。 

该 语句 的 执行 过 程 为 : 如 果 罗 辑 表 达 式 为 True 时 ,将 执行 Then 关键 字 后 的 语句 ; 否则 不 
执行 Then 后 语句 ， 而 直接 跳 转 到 下 一 条 语句 。 该 过 程 如 图 2-3 所 示 。 


图 2-3 ”If…Then 语句 流程 图 
例如 : 
lf sales = 10000 AND salary <45000 Then SlsCom = Sales * 0.07 
2. 多 行 条 件 语句 
当 风 辑 表达 式 为 真 时 需要 执行 多 行 代码 时 ， 需 要 使 用 多 行 条 件 语 句 。 其 结构 如 下 : 
lf 逻辑 表达 式 Then 
语句 块 
End If 
单行 条 件 结构 语句 和 多 行 条 件 语句 的 区 别 是 ， 单行 条 件 结构 语句 最 后 不 需要 End If 语句 
来 终止 整个 条 件 结构 ， 而 多 行 条 件 语 句 需 要 使 用 End If 标 识 条 件 结构 的 终结 。 
例如 : 


lf price = 7 AND units >= 50 Then 

rebate = (price * units) * 0.1 

Range("A4").Value = "The rebate is: $" & rebate 
End If 


2.6.4 If…Then…Else 语句 及 其 变 体 


在 上 面 介绍 的 ff…Then 语句 对 于 逻辑 表达 式 为 False 时 ， 没 有 提供 可 执行 的 语句 代码 块 ; 
当 在 逻辑 表达 式 为 False 时 要 执行 男 外 的 代码 ， 就 需要 使 用 If…Then…Else 语句 。 
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该 语句 也 有 两 种 格式 : 

1. 单行 条 件 结构 语句 

单行 条 件 结构 语句 的 书写 格式 如 下 : 

lf 逻辑 表达 式 Then 语句 1 Else 语句 2 

该 语句 的 执行 过 程 为 : 当 罗 辑 表 达 式 为 True 时 ， 执 行 语句 1;， 当 好 辑 表达 式 为 False 时 ， 
执行 语句 2。 该 过 程 如 图 2-4 所 示 。 


图 2-4 ”If…Then…Else 语句 流程 图 
例如 : 
If Sales>5000 Then Bonus = Sales * 0.05 Else MsgBox "No Bonus" 


2. 多 行 条 件 结构 语句 
当 要 执行 多 个 语句 时 ， 应 该 使 用 多 行 格式 的 If…Then…Else 语句 。 该 语句 的 格式 如 下 : 


lf 逻辑 表达 式 Then 
语句 序列 1 


Else 
语句 序列 2 
End If 


例如 : 
lf ActiveSheet.Name = "Sheet1" Then 

ActiveSheet.Name = "My Sheet" MsgBox "This sheet has been renamed.” 
Else 


MsgBox "This sheet name is not default." 
End If 


该 语句 还 有 一 种 变 体 格式 ， 其 格式 如 下 : 
If 逻辑 表达 式 1 Then 
语句 序列 1 
Elself 逻辑 表达 式 2 Then 
语句 序列 2 
Else 
语句 序列 N 
End If 
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办 公 应 用 旨 党 之 狗 
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该 变 体格 式 可 以 为 f…Then…Elself 语句 增加 一 个 分 支 ， 因 此 该 变 体格 式 通常 用 于 有 两 个 
以 上 条 件 分 支 时 。 


2.6.5 ”Select Case 多 分 支 语 句 


当 分 支 结构 较为 繁杂 时 , 应 该 考虑 使 用 Select Case 多 分 支 语句 。 虽然 可 以 使 用 If…Then*… 
ElseIf 语句 ， 但 当 所 有 的 Elself 语句 都 使 用 相同 的 逻辑 表达 式 结构 时 ， 其 结构 将 十 分 繁杂 ， 且 
不 易 阅 读 ， 维 护 困 难 。 

Select Case 多 分 支 语句 结构 的 语法 格式 如 下 : 

Select Case 测试 表达 式 

Case 表达 式 列表 1 
语句 序列 1 
Case 表达 式 列表 2 
语句 序列 2 
Case 表达 式 列表 N 
语句 序列 N 
Case Else 
没有 表达 式 匹 配 测试 表达 式 时 执行 的 语句 

End Select 

该 表达 式 在 其 开始 处 计算 测试 表达 式 ， 然 后 将 表达 式 的 值 与 结构 中 的 每 个 Case 值 进 行 比 
较 。 如 果 相 等 ， 就 执行 与 该 Case 相关 联 的 语句 块 ， 执 行 完 毕 后 跳 转 到 End Select 语句 后 执行 
其 他 语句 。 如 果 比 较 完 所 有 Case 语句 都 没有 匹配 的 分 支 ， 就 会 执行 Case Else 分 支 后 的 语句 代 
码 。 当 不 止 一 个 Case 语句 与 测试 表达 式 相 匹配 时 ， 则 只 执行 第 一 个 匹配 的 Case 结构 相关 的 语 
名 序列。 其 执行 过 程 图 如 图 2-5 所 示 。 


测试 表达 式 


语句 序列 ! | | 语句 序列 ?| | ”… | | 语句 序列 N 


图 2-5 Select Case 语句 流程 图 


其 中 测试 表达 式 可 以 是 数值 型 或 字符 型 的 表达 式 ， 通 常 是 一 个 该 数据 类 型 的 变量 。 表 达 
式 列表 可 以 是 一 个 或 者 几 个 值 的 列表 ， 如 果 在 一 个 列表 中 有 多 个 值 ， 就 用 逗号 隔 开 。 

表达 式 列表 的 书写 具体 有 以 下 几 种 情况 : 

口 具体 值 形式 : 该 表达 式 主要 用 于 体现 一 系列 具体 的 值 。 例 如 ，Case“ 张 ”，“ 刘 ”， 

“ 李 ” 

口 ” 取 值 范 围 形式 :该 形式 用 来 表示 一 个 数据 范围 。 例 如 ，Case 23 To 45。 

口 使 用 Ts 运算 符 : 例如 Case Is<200 表示 所 有 小 于 200 的 值 。 

以 上 3 种 格式 可 以 结合 使 用 。 以 下 是 Select Case 分 支 结 构 的 一 个 实例 : 


Ah 
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Select Case myButton 
Case6 
Workbooks.Add 
Case7 
MsgBox "You can open a new book manually later.” 
Case Else 
MsgBox "You pressed Cancel." 
End Select 


2.6.6 ”Do…Loop 语句 


前 面 介 绍 的 结构 语句 都 只 能 让 语句 顺序 执行 一 次 。 在 实际 处 理 过 程 中 ， 经 常 需要 用 同 种 
方法 对 各 个 数据 进行 重复 处 理 。 针 对 这 种 需要 重复 执行 具有 特定 功能 程序 段 的 程序 需要 使 用 
循环 结构 。 

Do 循环 语句 有 4 种 变 体 , 即 Do While…Loop、Do…Loop While、Do Until…Loop 和 Do… 
Loop Until 语句 。 只 要 (或 者 直到 ) 某 个 条 件 为 真 ， 就 会 重复 一 系列 的 语句 。 这 些 循环 语 句 重 
复 运行 代码 的 次 数 并 不 一 致 ， 需 要 视 情况 而 定 ， 但 每 种 循环 都 需要 计算 条 件 表达 式 的 值 。 

1. Do While…Loop 语句 

该 语句 的 一 般 语法 格式 如 下 : 

Do While 逻辑 表达 式 

语句 序列 

Loop 

当 该 语句 被 执行 时 ， 首 先 判断 逻辑 表达 式 。 如 果 为 False， 则 跳出 所 有 语句 ， 执 行 Loop 
语句 后 的 其 他 语句 ， 如 果 为 True， 则 执行 循环 体 ， 执 行 到 Loop 后 又 跳 转 到 Do While 语句 再 
次 对 逻辑 表达 式 进 行 计算 。 在 该 结构 中 可 以 使 用 Exit Do 语句 结束 循环 ， 跳 转 到 Loop 后 的 语 
句 继续 执行 。 该 语句 的 执行 顺序 如 图 2-6 所 示 。 


2-6 ”Do While…Loop 语句 流程 图 


办 公 应 用 非常 乞 乡 - 
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由 于 该 循环 结构 在 进入 循环 体 前 首先 对 逻辑 表达 式 进行 计算 ， 如 果 风 辑 表达 式 计算 结果 
为 False， 则 跳出 整个 循环 ， 所 以 该 结构 的 循环 体 可 能 一 次 都 不 会 被 执行 。 

下 面 是 该 结构 的 一 个 实例 : 


Do While Now < stopme 
Application.DisplayStatusBar = True 
Application. StatusBar = Now 
Loop 
2. Do…Loop While 语句 
Do…Loop While 语句 和 Do While…Loop 唯一 不 同 的 地 方 是 , 该 语句 是 首先 执行 一 次 循环 


体 之 后 才 开 始 检测 逻辑 表达 式 ， 因 此 该 语句 中 循环 体 至 少 会 被 执行 一 次 。 其 语法 结构 如 下 : 
Do 
语句 序列 
Loop While 逻辑 表达 式 


其 执行 流程 图 如 图 2-7 所 示 。 


图 2-7 Do…Loop While 语句 循环 流程 图 


下 面 是 该 语句 的 一 个 实例 。 
Do 
secretCode = InputBox("Enter your secret code:") 
If secretCode = "sp1045" Then Exit Do 
Loop While secretCode <> "sp1045" 


3. Do Until…Loop 语句 
该 结构 与 Do While…Loop 语句 不 同 之 处 是 ， 当 Until 后 的 逻辑 表达 式 为 假 时 该 语句 执行 


循环 体 ， 当 逻辑 表达 式 为 真 时 ， 跳 出 循环 。 此 语句 将 计算 逻辑 表达 式 置 于 语句 开始 ， 所 以 循 
环 体 可 能 一 次 都 未 被 执行 。 


Ah 


第 2 章 “VBA 程序 唤 站 项 We 


该 语句 的 语法 结构 如 下 : 


Do Until 逻辑 表达 式 
语句 序列 
Loop 


其 运行 的 流程 图 只 需要 将 Do While…Loop 语句 的 流程 图 (如 图 2-6 所 示 ) 中 对 录 辑 判断 
结果 一 一 真 假 互 换 位 置 即 可 。 
该 语句 的 一 个 实例 。 
Do Until lsEmpty(ActiveCell) 
ActiveCell.Font.Bold = True 


ActiveCell.Offset(1, 0).Select 
Loop 


4. Do…Loop Until 语句 
该 语句 的 语法 结构 如 下 : 
Do 


语句 序列 
Loop Until 逻辑 表达 式 


该 语句 和 Do Until…Loop 语句 类 似 ,不同 的 是 : 当 Until 后 的 逻辑 表达 式 为 假 时 该 语句 执 
行 循环 体 ， 当 逻辑 表达 式 为 真 时 ， 跳 出 循环 。 此 语句 将 计算 逻辑 表达 式 置 于 语句 开始 ， 所 以 
循环 体 可 能 一 次 都 未 被 执行 。 

下 面 是 该 语句 的 一 个 实例 。 

Do 


Worksheets(shcount).Select 
Set myRange = ActiveSheet.UsedRange 


If myRange.Address = "$A$1" And Range("A1").Value = " Then 
Application.DisplayAlerts = False 
Worksheets(shcount).Delete 
Application.DisplayAlerts = True 

End 上 

shcount = shcount -1 

Loop Until shcount = 1 


2.6.7 ”For…Next 语句 


For…Next 语句 以 指定 次 数 来 重复 执行 循环 体 。 与 Do 循环 不 同 , For 循环 使 用 一 个 计数 器 
的 变量 。 每 次 循环 之 后 ， 计 数 器 变量 的 值 就 会 增加 或 减少 一 个 固定 值 。 在 For 循环 中 可 以 使 用 
Exit For 语句 退出 循环 。For 循环 的 语法 结构 如 下 : 

For 循环 变量 = 初始 值 To 终 值 [Step 步 长 ] 


循环 体 语句 
Next [循环 变量 ] 
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其 中 的 步 长 可 以 为 负 值 。 当 其 为 正 值 时 ， 则 初始 值 
必须 小 于 或 等 于 终 值 , 循环 体 才 会 被 执行 。 当 其 为 负 值 
时 , 则 初始 值 必 须 大 于 或 等 于 终 值 , 循环 体 才 会 被 执行 。 | | 
该 步 长 的 默认 值 为 1。For…Next 循环 结构 的 执行 流程 
图 如 图 2-8 所 示 。 

该 语句 的 执行 流程 如 下 : 

(1) 将 初始 值 赋 予 循 环 变量 。 

(2) 判断 循环 变量 是 否 超过 终 值 ， 若 为 真 ， 则 退 
出 循环 ， 执 行 Next 后 的 语句 。 这 里 的 超过 终 值 有 两 种 
情况 : 如 果 步 长 为 负 值 时 ， 超过 就 是 循环 变量 的 值 小 于 
终 值 ， 反 之 ， 超 过 就 是 循环 变量 的 值 大 于 终 值 。 

(3) 执行 循环 体 语 句 。 

(4) 循环 体 执行 完 后 ， 将 循环 变量 累加 步 长 。 

(5) 跳 转 到 前 面 的 第 二 步 。 

For…Next 语句 的 循环 次 数 可 以 计算 出 来 ， 计 算 方 
法 如 下 《〈 中 括号 表示 对 结果 取 整 ) : 

循环 次 数 =[( 终 值 - 初 值 ))/ 步 长 ]+1 


循环 变量 累加 步 长 


图 2-8 For…Next 语句 流程 图 


全 注意 : 在 事先 不 知道 循环 执行 的 次 数 时 ， 应 该 采用 Do 循环 结构 ; 当知 道 循环 次 数 时 ， 应 
该 采用 For…Next 循环 结构 。 
以 下 是 该 语句 的 一 个 实例 : 
Forr= 1 To totalR-1 
lf ActiveCell = 0 Then 
Selection.EntireRow.Delete 
totalR = totalR-1 
Else 
ActiveCell.Offset(1, 0).Select 
End ff 
Next 


2.6.8 ”For Each…Next 语句 


For Each…Next 循环 与 For…Next 循环 类 似 , 但 该 语句 主要 针对 数组 或 对 象 集合 中 每 一 个 
元 素 重 复 执 行 一 组 代码 的 情况 。 当 不 知道 一 个 集合 中 有 多 少 个 元 素 时 ， 应 该 使 用 For Each… 
Next 循环 。 该 语句 的 语法 结构 如 下 : 

For Each 对 象 元 素 变量 In 对 象 集合 


语句 序列 
Next [对 象 元 素 变量 ] 


mh 
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该 语句 使 用 时 需要 注意 以 下 几 点 : 

口 “对象 元 素 变量 只 能 是 Variant 变量 ， 或 一 般 的 Object (对象 ) 类 型 ， 或 者 是 对 象 浏览 
器 中 列 出 的 对 象 。 

口 ” 对 于 数组 ， 对 象 元 素 变量 之 能 是 Variant 变量 。 

口 不 能 使 用 用 户 自 定义 类 型 的 数组 , 因为 Variant 数据 类 型 不 包含 用 户 自 定义 数据 类 型 。 

有 从 注意 : For 结构 的 语句 ， 在 Next 后 面 都 可 以 再 跟 一 个 变量 。For.…Next 后 跟 循 环 变量 ，For 

Each.…Next 后 跟 对 象 元 素 变量 ， 但 是 这 些 都 可 以 省 略 。 

以 下 是 该 语句 的 一 个 实例 。 

For Each mySheet In Worksheets 


ActiveWindow.SelectedSheets.Delete 
Next mySheet 


2.6.9” 跳 转 语句 


在 VBA 中 可 能 需要 代码 的 跳 转 执行 。 比 如 在 循环 结构 的 循环 体 运行 过 程 中 ， 有 时 候 需 要 
直接 跳出 循环 体 ， 继 续 执行 循环 结构 后 面 代码 。 

当 要 跳 转 执行 代码 时 ， 有 以 下 几 种 办 法 。 

1. 使 用 Exit 终止 当前 结构 

使 用 Exit 语句 ,将 会 终止 当前 结构 , 跳 转 到 当前 结构 后 面 的 执行 代码 ,该 语句 包括 Exit Do、 
Exit For、Exit Function 和 Exit Sub 4 种 表达 方式 。 分 别 终止 对 应 的 结构 。 下 面 是 一 实例 。 

Sub ExitStatementDemo() 


Dim 1, MyNum 
Do ' 建 立 无 穷 循环 
For1=1To 1000 "循环 1000 次 
MyNum = Int(Rnd * 1000) "生成 一 随机 数码 
Select Case MyNum "检查 随机 数码 
Case 7: Exit For "如 果 是 7， 退 出 For…Next 循环 
Case 29: Exit Do "如 果 是 29， 退 出 Do…Loop 循环 
Case 54: Exit Sub "如 果 是 54， 退 出 子 过 程 
End Select 
Next | 
Loop 
End Sub 


2. GoTo 语句 (On Error GoTo) 

直接 使 用 GoTo 语句 的 情况 不 常见 ， 为 了 维护 程序 结构 性 ， 应 该 尽量 少 使 用 GoTo 语句 。 
通常 使 用 该 方式 的 情况 是 针对 错误 处 理 。 此 时 是 在 On Error GoTo 语句 后 面 跟 跳 转 标记 。 下 面 
是 一 个 实例 。 


Sub GotoStatementDemo!() 
Dim Number, MyString 


Ey 


句 。 
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Number =1 ' 设 置 变 量 初始 值 
"判断 Number 的 值 以 决定 要 完成 哪 一 个 程序 区 段 ( 以 “程序 标签 ”来 表示 )》 
If Number = 1 Then GoTo Line1 Else GoTo Line2 


Line1: 
MyString = "Number equals 1" 
GoTo LastLine ' 完 成 最 后 一 行 
Line2: 
"下 列 的 语句 根本 不 会 被 完成 。 
MyString = "Number equals 2" 
LastLine: 
Debug.Print MyString 将 "Number equals 1" 显 示 在 立即 窗口 
End Sub 


2.7 常见 函数 与 语句 


VBA 中 除了 各 种 控制 结构 语句 以 外 ， 还 提供 了 程序 注释 以 及 对 话 框 形式 的 输入 、 输 出 语 
这 些 功 能 可 以 辅助 开发 者 完善 系统 的 功能 ， 减 轻 维 护 负 担 等 。 


2.7.1 注释 语句 


在 程序 代码 中 ， 适 当 加 入 注释 可 以 提高 程序 的 可 读 性 ， 方 便 代 码 的 阅读 和 维护 。 注 释 语 


句 的 格式 如 下 : 


口 Rem 注释 内 容 。 
口 ' 注 释 内 容 。 
Rem 注释 方式 一 般 只 适宜 齐 头 方式 注释 。 如 果 需 要 在 语句 尾部 加 注释 ， 则 需要 在 Rem 前 


面 加 冒号 分 割 开 两 条 语句 ， 或 者 使 用 ' 注 释 方式 。 
名 注意 : 本 书 的 所 有 程序 步骤 都 是 采用 ' 注 释 方式 。 


2.7.2 InputBox 函数 


InputBox 函数 用 于 获取 输入 ， 该 函数 将 显示 一 个 输入 对 话 框 ， 用 户 在 其 中 输入 内 容 后 选 


择 确认 。 该 函数 的 返回 值 为 文本 框 内 容 的 字符 串 数据 。 其 语法 结构 为 : 


返回 值 =InputBox(Prompt,[title][,default][,xpos,ypos][,helpfile,context]) 

其 中 各 参数 的 含义 如 下 : 

口 Prompt: 显示 在 输入 对 话 框 中 的 提示 信息 ， 最 大 长 度 为 1024 个 字符 。 

口 title: 可 选 ， 输 入 对 话 框 的 标题 。 省 略 时 ， 显 示 应 用 程序 名 。 

口 default: 可 选 ， 文 本 框 中 默认 的 显示 内 容 。 如 果 省 略 ， 则 文本 框 为 空 。 

口 ”xpos(ypos): 可 选 ， 数值 表达 式 ， 指 定 对 话 框 左 (上 ) 边 与 屏幕 左 (上 ) 边 的 水 平 〈 垂 


ff 
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直 ) 距离 。 如 果 省 略 ， 则 对 话 框 放 置 在 水 平 居中 《屏幕 垂直 方向 下 边 大 约 三 分 之 二 ) 
的 位 置 。 

口 helpfile: 可 选 ， 字 符 串 表 达 式 ， 标 识 识 别 帮 助 文 件 ， 用 该 文件 为 对 话 框 提供 上 下 文 
相关 的 帮助 。 如 果 使 用 了 该 参数 ， 也 必须 提供 context。 

口 “context: 可 选 ， 数 值 表达 式 ， 由 帮助 文件 的 作者 指定 给 某 个 帮助 主题 的 帮助 上 下 文 编 
号 。 如 果 已 提供 context， 也 必须 提供 helpfile 。 

InputBox 函数 无 论 输入 的 是 数字 还 是 字符 ， 其 返回 值 始终 都 是 字符 型 。 单 击 【 确 定 】 按 

钮 ， 返 回 文本 框 中 的 内 容 ; 单 击 【取消 】 按 钮 ， 将 返回 一 个 零 长 度 字符 串 。 


名 注意 : 如 果 Prompt 中 包含 了 多 行 ， 则 可 以 在 各 行 间 使 用 回 车 符 Chr(13)、 换 行 符 Chr(10) 或 
回 车 Chr(13) & Chr(10) 来 分 隔 。 


2.7.3 ”MsgBox 函数 


该 函数 主要 使 用 对 话 框 的 形式 显示 一 些 简单 的 错误 、 和 警告 或 提示 信息 给 用 户 ， 等 待 用 户 
的 相应 操作 。 其 用 法 有 语句 与 函数 两 种 格式 。 语 句 格式 如 下 : 

MsgBox Prompt [,Buttons] [,title] [,helpfile,context] 

函数 格式 如 下 : 

返回 值 =MsgBox(Prompt [,Buttons] [,title] [,helpfile,context]) 

和 InputBox 函数 的 参数 意义 基本 一 致 ， 其 中 不 同 的 是 Buttons 参数 。 该 参数 用 来 指定 显 
示 按 钮 的 数目 与 样式 、 图 标 样式 、 默 认 按钮 以 及 消息 框 的 强制 响应 。 参 数 具 体 设 置 如 表 2-8~ 
表 2-11 所 示 。 

表 2-8 按钮 数目 与 形式 设置 表 


常量 值 说 了 明 
vbOkOnly 0 只 显示 【确定 】 按 钮 
vbOkCancel 1 显示 【确定 】 及 【取消 】 按 钮 
vbAbortRetryLgnore 显示 【异常 终止 站、【 重 试 】 及 【忽略 】 按 钮 
vbYesNoCancel 3 显示 【是 】【 否 】 及 【取消 〗 按 钮 
vbYesNo 4 显示 【是 】 及 【 否 】 按 钮 
vbRetryCancel Ee 显示 【 重 试 】 及 【取消 〗 按 钮 


表 2-9 图 标 样式 设置 表 


常 量 值 说 明 
vbCriitical 16 显示 Critical Message 图 标 
vbQuestion 32 显示 Warning Query 图 标 六 
vbExclamation 48 显示 Warning Message 图 标 心 
vbInformation 64 显示 Information Message 图 标 噶 


常 量 
vbDefaultButton1 | 0 


说 了 明 


以 第 一 个 按钮 为 默认 按钮 
vbDefaultButton2 以 第 二 个 按钮 为 默认 按钮 
vbDefaultButton3 以 第 三 个 按钮 为 默认 按钮 


以 第 


vbDefaultButton4 四 个 按钮 为 默认 按钮 


以 上 表 中 列 出 的 常量 都 是 VBA 的 系统 常量 , 当 需 要 将 多 个 设置 结合 使 用 时 , 可 以 使 用 “+” 
将 各 个 常量 连接 起 来 。 例 如 : 
MsgBox "你 显示 了 确定 按钮 和 消息 图 标 ! "vbOkOnly+vblnformation 


2.8 数 组 


数组 就 是 由 一 系列 具体 相同 属性 的 、 连 续 的 数据 变量 组 成 的 集合 。 数 组 是 相当 常见 并 使 
用 广泛 的 一 种 数据 结构 。 同 一 个 数组 具有 相同 的 变量 名 ， 通 过 索引 值 加 以 区 别 数 组 中 的 各 个 


2.8.1 了 解数 组 定义 及 上 下 界 


定义 数组 的 语法 如 下 : 

Dim 数组 名 (n) As type 

该 数组 包括 的 数组 元 素 是 n 个 。 例 如 : 下 面 定义 一 包含 10 个 元 素 的 字符 串 数 组 。 

Dim strName(9) As String 

在 默认 情况 下 ， 数 组 的 元 素 的 索引 值 是 从 零 开始 的 。 上 面 的 数组 在 引用 其 元 素 时 只 能 引 
用 strName(0) 到 strName(9) 之 间 的 10 个 。 如 果 需 要 索引 值 从 1 开始 计数 ， 需 要 使 用 以 下 命令 : 

Option Base 1 

当 使 用 该 命令 后 ， 上 面 的 实例 包含 的 数组 元 素 个 数 为 9 个 ， 引 用 时 只 能 使 用 strName(1) 
到 strName(9) 间 的 所 有 数组 元 素 。 

不 使 用 该 命令 ， 而 又 要 索引 值 从 1 开始 时 ， 在 定义 数组 时 需要 采用 如 下 方式 : 


Dim FirstArray(1 to 25) As Integer 
Dim SecondArray(20 to 100) As Integer 


Ah 
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这 里 定义 时 明确 指示 了 数组 的 上 下 界 。 每 个 数组 都 有 一 个 下 界 和 上 界 。 下 界 即 数组 的 
最 小 索引 值 ， 上 界 即 数组 最 大 索引 值 。 这 里 的 上 下 界 可 以 任意 定义 ， 但 是 要 保证 下 界 小 于 
上 界 。 


2.8.2 多维 数组 


以 上 所 涉及 的 数组 都 是 一 维 数组 ， 一 维 数组 都 只 需要 一 个 数字 就 可 以 确定 数组 元 素 在 数 
组 中 的 位 置 。 在 某 些 情况 下 ， 只 有 一 个 维度 是 不 够 的 ， 此 时 就 需要 使 用 多 维 数组 。 要 声明 二 
维 数组 ， 只 需要 在 一 维 数组 的 基础 上 再 添加 一 个 参数 即 可 。 下 面 的 实例 将 创建 一 个 包含 $ 行 
和 10 列 的 数组 ， 共 包括 50 个 数组 元 素 。 

Dim MultiArray(1to 5,1to 10) 


2.8.3 动态 数组 


有 时 候 ， 可 能 并 不 知道 到 底 需 要 将 数组 定义 多 大 规模 。 随 着 程序 的 执行 ， 才 能 确定 该 数 
组 包含 多 少 个 数组 元 素 。 虽 然 可 以 定义 一 个 很 大 容量 的 数组 ， 但 是 这 样 做 非常 浪费 系统 的 内 
存 资 源 ， 这 时 就 需要 使 用 动态 数组 。 

动态 数组 指 没有 设置 大 小 的 数组 。 声 明 该 数组 时 ， 括 号 内 部 不 用 填 入 任何 数值 。 例 如 : 

Dim DynamicArray() 

当 在 程序 执行 过 程 中 ， 和 需要 修改 数组 大 小 时 ， 可 以 使 用 Redim 命令 。 例 如 : 

Redim DynamicArray(1to 20) 

其 中 的 上 下 界 可 以 使 用 变量 ， 例 如 下 例 将 活动 工作 适中 的 所 有 表 名 存储 到 数组 中 。 


Sub SaveSheetName() 
Dim strSheetName() As String 
Dim IntSheetsCount As Integer,IntSheetsNumber As Integer 


IntSheetsNumber=ActiveWorkbook.Worksheets.Count ' 获 得 活动 工作 短工 作 表 的 数目 

Redim strSheetName(1 to IntSheetsNumber) ' 重 定义 数组 大 小 

For IntSheetsCount=1 To IntSheetsNumber "循环 工作 表 ， 将 表 名 存储 到 数组 
strSheetName(IntSheetsCount)=ActiveWorkbook.Sheets(IntSheetsCount).Name 

Next 

End Sub 


有 了 时候 ， 可 能 需要 反复 修改 数组 的 大 小 。 但 是 每 次 使 用 Redim 后 ， 数 组 都 会 被 重新 初始 
化 ， 其 中 存储 在 数组 中 的 数据 都 会 丢失 。 为 了 避免 出 现 这 种 情况 ， 需 要 使 用 Preserve 命令 。 下 
面 的 实例 将 C 盘 根 目 录 下 所 有 TXT 文件 的 文件 名 放 入 一 个 数组 。 

Sub SavetxtFileName() 


Dim strFileName As String, arrName() As String 
Dim IntFileCount As Integer 


办 公 应 用 绰 党 乞 儿 . 
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strFileName=Dir("C:\* .txt") 

Do Until strFileName=" " 
IntFileCount= IntFileCount+1 
Redim Preserve arrName(1 To IntFileCount) 
arrName(IntFileCount)= strFileName 
strFileName=Dir 


Loop 
End Sub 
2.8.4 5 个 数组 相关 函数 和 语句 


"取得 第 一 个 C 盘 根 目录 下 的 TXT 文件 名 称 
' 当 文件 名 称 获取 成 功 时 ， 执 行 循 环 体 

' 将 文件 计数 器 累加 一 次 
"修改 文件 名 数组 的 大 小 

' 将 获得 的 文件 名 保存 到 文件 名 数组 中 

"继续 获取 下 一 TXT 文件 的 文件 名 


本 节 将 介绍 5 个 与 数组 相关 的 函数 与 语句 ， 分 别 是 Array、IsArray、Erase、LBound 和 


Ubound 。 
1. Array 


该 函数 返回 一 个 Variant 数据 类 型 的 数组 。 其 语法 格式 如 下 : 


数组 名 =Array( 参 数列 表 ) 


参数 列表 是 用 逗号 隔 开 的 值 表 ， 用 于 为 数组 的 各 元 素 赋值 。 如 果 不 提供 参数 ， 则 创建 一 


个 零 长 度 的 数组 。 
Dim arr As Variant 
arr = Array(10,20,30) 


2. IsArray 


该 函数 返回 一 个 布尔 值 ， 标 识 变量 是 否 为 一 个 数组 。 其 语法 格式 如 下 : 


lsArray( 变 量 名 或 数组 名 ) 

如 下 是 该 函数 使 用 的 一 个 实例 : 

Dim MyArray(1 To 5) As Integer, YourArray, MyCheck 
YourArray = Array(1, 2, 3) 


MyCheck = IsArray(MyArray) 
MyCheck = IsArray(YourArray) 


3. Erase 
该 语句 用 于 重新 初始 化 大 小 固定 的 数组 的 元 素 ， 
如 下 : 
Erase 数组 名 
下 面 是 该 函数 应 用 的 一 个 实例 : 
Dim NumArray(10) As Integer 


Dim StrVarArray(10) As String 
Dim VarArray(10) As Variant 


"声明 数组 变量 
"使 用 数组 函数 
"返回 True 
"返回 True 


以 及 释放 动态 数组 的 存储 空间 。 格 式 


"Integer 数组 
' 变 长 的 String 数组 
"Variant 数组 


Ah 
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Erase NumArray ' 将 每 个 元 素 设 为 0 
Erase StrVarArray "将 每 个 元 素 设 为 零 长 度 字符 串 
Erase VarArray ' 将 每 个 元 素 设 为 Empty 


4. LBound 和 UBound 


LBound 返回 一 个 Long 型 数据 ， 其 值 指 定数 组 下 界 。UBound 返回 一 个 Long 型 数据 ， 其 
值 指定 数组 上 界 。 


2.8.5 在 VBA 中 使 用 数组 


1. 使 用 连续 单元 格 区 域 的 值 填充 数组 

用 Excel 做 VBA 开发 时 ， 经 常 需要 获取 接连 的 几 行 几 列 单元 格 的 值 。 如 果 循环 各 个 单元 
格 来 获取 值 ， 速 度 比较 慢 ， 而 且 需 要 多 个 步骤 才能 完成 ， 这 时 可 以 使 用 数组 ， 将 这 些 连 续 的 
单元 格 直接 填充 到 该 数组 中 。 通 常 有 两 种 方法 ， 实 例如 下 : 

arrFil=ActiveWorkbook.sheet1.Range('A1:C57) 

arrFil= ActiveWorkbook.sheet1.Range('DataArea ) 

此 处 第 二 种 方式 ， 预 先 定义 了 连续 单元 格 的 名 称 ， 故 可 以 使 用 名 称 直接 访问 单元 格 区 域 。 

2. 数组 的 传递 

在 VBA 中 有 时 候 需要 传递 多 个 值 到 其 他 的 函数 或 过 程 做 进一步 处 理 。 如 果 这 些 值 的 类 型 
以 及 使 用 方式 都 一 致 时 ， 可 以 考虑 使 用 数组 进行 传递 ， 使 代码 运行 更 加 快速 和 更 易 阅 读 。 下 
面 的 实例 中 子 过 程 CheckValue 将 数组 传递 到 函数 Less5Number 中 , 用 于 计算 A1:C3 单元 格 范 
围 内 小 于 5 的 单元 格 个 数 。 


Sub CheckValue() 
Dim arr() As Variant 


arr = Sheet1.Range("A1:C3") ' 将 A1:C3 单元 格 的 数据 填充 到 数组 arr 中 
MsgBox "A1:C3 单元 格 范围 内 共有 " & Less5Number(arr) & "个 单元 格 的 数据 小 于 5! " 
End Sub 


Function Less5Number(ByRef arrData As Variant) As Integer 
Dim i, j, intCount As Integer 


Fori=1To3 
Forj=1To3 
lf arrData(i, j) < 5 Then 
intCount = intCount + 1 
End If 
Next 
Next 


Less5Number = intCount 
End Function 
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Excel 2007 VBA 对 和 象 模型 用 于 描述 Excel 2007 各 对 和 象 
之 间 的 关系 。 在 Excel 2007 中 使 用 VBA 进行 应 用 开发 时 ， 
首先 清楚 了 解 Excel 2007 的 对 象 模型 可 以 起 到 事半功倍 的 
效果 。Excel 所 包含 的 对 象 非常 多 , 但 是 其 中 很 多 并 不 常用 。 
本 章 重 点 介绍 在 VBA 开发 中 常用 的 对 象 以 及 其 属性 和 方 
法 。 这 些 对 象 包括 Application 对 象 、Workbook 对 象 、 
Worksheet 对 象 和 Range 对 象 。 这 4 个 常用 对 象 是 按照 层 
级 结构 组 织 的 〈 如 图 3-1 所 示 ) 。 


Worksheet 对 象 


图 3-1 Excel 2007 VBA 对 象 模型 


3.1 面向 对 象 编程 


“对 象 ”是 面向 对 象 程序 设计 的 核心 ， 明 确 这 个 概念 对 理解 面向 对 象 程序 设计 来 说 至 关 
重要 。 所 谓 对 象 就 是 具有 某 些 特性 的 具体 事物 的 抽象 。 在 现实 生活 中 ， 其 实 大 家 随时 随地 都 
在 和 对 象 打交道 ， 比 如 骑 的 自行 车 、 看 的 书 甚至 于 单个 的 人 ， 都 是 可 以 被 视 为 对 象 。 

这 些 现实 生活 中 的 对 象 有 3 个 共同 的 特点 。 第 一 ， 对 象 都 有 自己 的 状态 。 例 如 一 个 球 有 
自己 的 质地 、 颜 色 、 大 小 ;第 二 ， 对 象 都 具有 自己 的 行为 ， 例 如 一 个 球 可 以 滚动 、 停 止 或 旋 
转 ， 第 三 ， 对 象 都 具有 激发 其 行为 的 特殊 事件 ， 比 如 要 让 一 个 球 滚动 ， 需 要 给 这 个 球 的 表面 
施加 一 个 外 力 ， 而 要 球 停止 ， 需 要 有 阻力 施加 到 球 上 。 

在 面向 对 象 的 程序 设计 中 ， 对 象 的 概念 就 是 对 现实 世界 中 对 象 的 模型 化 。 在 面向 对 象 编 
程 中 ， 程 序 通过 定义 一 部 分 变量 并 赋予 其 具有 实际 意义 的 值 作为 对 象 固有 属性 的 描述 ， 还 通 
过 建立 一 些 过 程 完成 具有 实际 意义 的 动作 来 代表 对 象 相应 的 行为 ， 从 而 在 程序 设计 中 模拟 出 
该 对 象 。 这 些 模拟 实际 对 象 属性 的 变量 被 称 为 对 象 的 属性 ， 用 于 模拟 实际 对 象 行为 的 过 程 被 
称 为 对 象 的 方法 。 


3.1.1 对象 的 属性 


属性 决定 一 个 对 象 的 外 观 和 状态 ， 要 改变 一 个 对 象 的 外 观 和 状态 ， 可 以 通过 改变 对 象 的 
属性 实现 。 在 Excel 2007 VBA 中 建立 的 大 多 数 对 象 的 属性 是 在 对 象 生成 时 自动 设置 的 。 用 户 
也 可 以 在 设计 时 通过 属性 窗口 或 运行 时 通过 代码 修改 。 在 运行 时 可 以 设置 并 获得 值 的 属性 是 
可 读 写 属性 ; 在 运行 时 只 能 读 取 的 属性 叫做 只 读 属 性 。 


Ah 
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1. 设置 属性 值 

设置 属性 值 可 以 通过 VBE 开发 环境 下 的 属性 窗口 进行 ， 也 可 以 在 程序 代码 中 设置 。 通 过 
代码 设置 属性 值 的 格式 如 下 : 

对 象 .属性 名 称 = 表达 式 

下 面 的 实例 将 “实例 表 ” 的 标签 名 称 修改 为 “标签 名 修改 ”。 

Sheets(" 实 例 表 ")=" 标 签名 修改 " 

2. 读 取 属 性 值 

在 程序 设计 过 程 中 ， 有 时 候 需 要 将 对 象 当前 的 属性 值 保 存 起 来 ， 以 便于 以 后 恢复 ， 此 时 
就 需要 读 取 属 性 。 读 取 属 性 的 语法 格式 如 下 : 

变量 名 = 对 象 .属性 名 称 

如 果 在 代码 中 不 是 反复 使 用 到 对 象 的 该 属性 ， 也 可 以 不 将 该 属性 的 值 保存 到 变量 中 。 下 
面 的 实例 代码 在 Labell 标签 控件 的 显示 文字 后 面 添 加 字符 串 “《〈 显 示 字 符 串 ) ”。 

Label1.Caption= Label1.Caption & " (显示 字符 串 ) " 


3.1.2 ”对 象 的 方法 


对 象 的 方法 是 指 对 象 可 以 进行 的 操作 。 方 法 可 以 改变 对 象 的 属性 值 ， 也 可 以 对 存储 在 对 
象 中 的 数据 进行 某 项 操作 。 例 如 : 对 于 一 个 单元 格 区 域 对 象 Range， 可 以 使 用 Select 方法 选中 
某 个 单元 格 ， 也 可 以 使 用 ClearContent 方法 清除 该 单元 格 的 内 容 。 对 象 的 方法 实际 上 是 对 象 的 

- 些 成 员 函 数 。 

调用 对 象 的 方法 时 ， 需 要 使 用 点 号 操作 符 。 如 果 有 参数 ， 则 在 方法 后 面 加 上 参数 值 ， 参 
数 间 用 空格 隔 开 。 调 用 的 格式 如 下 ; 

对 象 .方法 名 称 < 参数 列表 > 

下 面 是 一 个 实例 ， 首 先 选 中 工作 表 Sheetl 的 Al 单元 格 ， 然 后 清除 该 单元 格 的 内 容 。 

With Sheet1.Range("A1") 


.Select 选择 A1 单元 格 
.ClearContent "清除 A1 单元 格 的 内 容 
End With 


3.1.3 ”对 象 的 事件 


事件 是 对 象 识别 的 需要 响应 的 某 些 用 户 行为 和 动作 。 很 多 情况 下 ，Excel 2007 VBA 事件 
是 通过 用 户 的 交互 操作 发 生 的 。 可 以 激发 事件 的 用 户 动 作 包 括 切换 工作 表 、 选 择 单元 格 、 单 
击 鼠 标 、 双 击 鼠 标 等 。 当 事件 发 生 时 ， 将 执行 包含 在 事件 过 程 中 的 代码 。 

事件 按照 对 象 层次 结构 分 为 应 用 程序 事件 、 工 作 短 事 件 、 工 作 表 事件 和 图 表 事 件 。 每 一 


办 公 应 用 绯 党 乞 比 - 


Excel VBA 应 用 开发 经 典 案例 


种 层次 都 包含 很 多 种 事件 。 在 VBE 编辑 器 中 ， 当 打开 了 对 应 对 象 的 代码 编辑 窗口 后 ， 在 该 窗 
口 右上 方 的 下 拉 列 表 框 中 可 以 选择 对 应 对 象 的 事件 。 

有 了 时候， 事件 会 触发 其 他 事件 ， 包 括 该 事件 本 身 。 例 如 : 当 单 元 格 中 的 内 容 发 生变 更 时 ， 
工作 表 的 Worksheet_Change 事件 被 触发 。 如 果 在 Worksheet_Change 事件 的 过 程 代码 中 又 修改 
了 一 个 单元 格 内 容 ， 那 么 事件 将 被 再 次 激发 。 以 此 类 推 ， 循 环 往复 ， 过 程 就 陷入 了 死 循环 之 
中 。 为 了 防止 该 情况 发 生 ， 可 以 在 事件 过 程 开 始 部 分 设置 禁止 激发 事件 ， 最 后 在 过 程 的 尾部 
重新 启动 。 禁 止 事件 激发 的 方法 如 下 例 所 示 : 

Private Sub Worksheet_Change(Byval Target As Range) 


Application.EnableEvents=False "禁止 激发 事件 

Range("A1").Value=Target Value "修改 A1 单元 格 的 值 

Application.EnableEvents=True "取消 禁止 激发 事件 
End Sub 


公 注意: 当 程序 陷入 死 循环 后 ， 可 以 按 Esc 键 或 CtrIHBreak 组 合 键 中 断 程序 执行 。 
3.2 Application 对 象 


Application 对 象 处 于 Excel 2007 VBA 对 象 层 级 结构 的 最 高 层 。 该 对 象 代 表 了 当前 正在 运 
行 的 Excel 2007 应 用 程序 ， 其 他 的 对 象 都 是 该 对 象 的 子 对 象 。 设 置 Application 的 属性 将 影响 
整个 Excel 2007 应 用 程序 。 

3.2.1 Application 对 象 常用 属性 


Application 对 象 的 属性 很 多 ， 以 下 给 出 的 只 是 其 中 常用 的 属性 。 


口 ActiveWorkbook: 返回 当前 活动 的 工作 短 。 

口 ”ActiveSheet: 返回 当前 活动 的 工作 短 中 活动 的 工作 表 。 返 回 的 工作 表 可 以 是 Excel 支 
持 的 所 有 工作 表 类 型 ， 包 括 工 作 表 或 图 表 。 

口 ActiveCell: 返回 当前 活动 工作 短 中 活动 工作 表 中 的 活动 单元 格 。 

口 AskToUpdateLinks: 设置 当 打开 带 有 链接 的 文件 时 询问 用 户 是 否 更 新 链接 。 设 置 为 


True 时 ，Excel 显示 对 话 框 询问 是 否 更 新 链接 ， 设置 为 False 时 ，Excel 自动 更 新 链接 
且 不 显示 对 话 框 。 

口 Caption: 返回 或 设置 Excel 程序 标题 栏 上 的 标题 。 

口 DisplayAlerts: 设置 是 否 显示 警告 信息 对 话 框 。 设 置 为 True 时 ， 显 示警 告 信息 ; 设置 
为 False 时 ， 不 显示 警告 信息 。 

口 DisplayStatusBar: 设置 Excel 状态 条 是 否 显示 。 设 置 为 True 时 ， 显 示 状 态 条 ; 设置 
为 False 时 ， 不 显示 状态 条 。 

口 DisplayFormulaBar: 设置 是 否 显示 编辑 栏 。 设 置 为 True 时 , 显示 编辑 栏 ; 设置 为 False 
时 ， 不 显示 编辑 栏 。 


mh 
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口 FileDialog: 该 属性 可 以 用 来 开启 多 种 关于 文件 的 对 话 框 。 下 例 是 开启 打开 文件 对 话 
框 的 代码 。 
Application.FileDialog( msoFileDialogOpen).Show 


口 Path: 返回 应 用 程序 完整 路 径 的 字符 串 。Path 不 包括 末尾 的 分 隔 符 和 应 用 程序 名 称 。 

口 ”SceenUpdating: 开启 或 关闭 屏幕 刷新 。 设 置 为 True 时 ， 开 启 刷新 ， 设 置 为 False 时 
关闭 刷新 。 

口 Selection: 确定 当前 活动 的 对 象 是 什么 。 可 以 是 工作 表 、 图 表 、 单 元 格 、 图 形 对 象 等 。 


3.2.2” Application 对 象 常用 方法 


Application 对 象 的 常用 方法 如 下 : 

口 FindFile: 显示 【打开 】 对 话 框 并 让 用 户 打 开 一 个 文件 。 如 果 成 功 打开 一 个 新 文件 ， 
则 该 方法 返回 True; 如果 用 户 退 出 该 对 话 框 ， 则 该 方法 返回 False。 

口 “GetOpenFilename: 显示 标准 的 【打开 】 对 话 框 ， 并 获取 用 户 文件 名 ， 但 不 真正 打开 


该 文件 。 
口 GetSaveAsFilename: 显示 标准 的 【另存 为 】 对 话 框 ， 获 取 用 户 文件 名 ， 但 不 真正 保 
存 文件 。 


口 OnKey: 当 按 特定 键 或 特定 的 组 合 键 时 运行 指定 的 过 程 。 

口 OnTime: 在 将 来 的 特定 时 间 运 行 一 个 既定 过 程 〈 既 可 以 是 具体 指定 的 某 个 时 间 ， 也 
可 以 是 指定 的 一 段 时 间 之 后 ) 。 

Quit， 退出 Excel 应 用 程序 。 

SendKeys: 将 击 键 发 送 给 活动 应 用 程序 。 

Volatile: 用 于 将 用 户 自 定义 函数 标记 为 易 失 性 函数 。 无 论 何 时 在 工作 表 的 任意 单元 
格 中 进行 计算 时 ， 易 失 性 函数 都 必须 重新 进行 计算 。 非 易 失 性 函数 只 在 输入 变量 改 
变 时 才 重 新 计算 。 


DO 


3.3 Workbook 对 象 


Workbook 工作 德 对 象 位 于 Application 对 象 的 下 一 层次 。 一 个 工作 敌对 象 代表 一 个 Excel 
文件 。Worksheet 工作 表 对 象 、Range 单元 格 对 象 等 都 包含 在 该 对 象 中 。Workbooks 是 该 对 象 
的 集合 ， 使 用 Application 对 象 的 Workbooks 属性 可 以 访问 当前 打开 的 所 有 工作 敌对 象 。 


3.3.1 Workbook 对 象 常用 属性 


Workbook 对 象 常用 属性 如 下 : 
口 ”ActiveSheet: 返回 活动 工作 竹中 或 指定 的 窗口 或 工作 竹中 的 活动 工作 表 。 如 果 没 有 活 
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动 的 工作 表 ， 则 返回 Nothing。 

口 FullName: 返回 Workbook 对 象 的 名 称 。 以 字符 串 表 示 ， 包 括 其 磁盘 路 径 。 

口 Path: 返回 一 个 String 值 ， 该 属性 代表 应 用 程序 的 完整 路 径 ， 不 包括 末尾 的 分 隔 符 和 
应 用 程序 名 称 。 

口 ”Saved: 如 果 指定 工作 短 从 上 次 保存 至 今 未 发 生 过 更 改 ， 则 该 属性 值 为 True， 和 否则 为 
False。 该 属性 可 以 读 写 。 

口 “Sheets: 返回 一 个 Sheets 集合 ， 该 属性 代表 指定 工作 适中 的 所 有 工作 表 。 

口 Windows: 返回 一 个 Windows 集合 ， 该 属性 代表 指定 工作 适中 的 所 有 窗口 。 


3.3.2 ” ”Workbook 对 象 常用 方法 


Workbook 对 象 常用 方法 如 下 : 

Activate: 激活 与 工作 短 相 关 的 第 一 个 窗口 。 

Close: 关闭 对 象 。 

PrintOut， 打 印 对 象 。 

PrintPreview: 按 对 象 打印 后 的 外 观 效果 显示 对 象 的 预览 。 
Protect: 保护 工作 簿 使 其 不 被 修改 。 

Save: 保存 对 指定 工作 簿 所 做 的 更 改 。 

SaveAs: 在 另 一 不 同文 件 中 保存 对 工作 德 所 做 的 更 改 。 
Unprotect: 取消 工作 表 或 工作 秒 的 保护 。 如 果 工 作 表 或 工作 适 不 是 受 保护 的 ， 则 此 
方法 不 起 作用 。 

UpdateLink: 更 新 链接 、DDE 链接 或 OLE 链接 。 


OOOOOOODO 


口 


3.4 Worksheet 对 象 


Worksheet 对 象 代表 Excel 工作 筹 中 包含 的 工作 表 。 通 过 该 对 象 ， 可 以 在 程序 中 完成 各 种 
对 工作 表 的 操作 。 多 个 Worksheet 对 象 组 成 Worksheets 集合 ， 可 以 使 用 该 集合 集中 访问 工作 
表 对 象 。 


3.4.1 Worksheet 对 象 常用 属性 


Worksheet 对 象 常用 属性 如 下 : 

口 “AutoFilter: 如 果 筛 选 已 打开 ， 则 返回 一 个 AutoFilter 对 象 。 

口 ”AutoFilterMode: 如 果 当 前 在 工作 表 上 显示 有 “自动 筛选 "下拉 箭 头 ， 则 该 值 为 True。 
本 属性 与 FilterMode 属性 互相 独立 ， 可 读 写 。 

口 Cells: 返回 一 个 Range 对 象 ， 该 属性 代表 工作 表 中 的 所 有 单元 格 。 


Ah 
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CodeName: 返回 对 象 的 代码 名 。 

Columns: 返回 一 个 Range 对 象 。 该 属性 代表 活动 工作 表 中 的 所 有 列 ， 是 列 的 集合 ， 
使 用 该 属性 可 以 访问 具体 的 列 。 

FilterMode: 如 果 工 作 表 处 于 筛选 模式 ， 则 为 True， 否 则 为 False。 

Hyperlinks: 返回 Hyperlinks 集合 ， 该 属性 代表 区 域 的 所 有 超 链接 。 

Name: 返回 或 设置 Worksheet 对 象 的 名 称 。 

Next: 返回 代表 下 一 个 工作 表 的 Worksheet 对 象 。 

PageSetup: 返回 一 个 PageSetup 对 象 ， 该 属性 包含 用 于 指定 对 象 的 所 有 页 面 设 置 。 
Previous: 返回 代表 下 一 个 工作 表 的 Worksheet 对 和 象 。 

Range: 返回 一 个 Range 对 象 。 该 属性 代表 一 个 单元 格 或 单元 格 区 域 。 

Rows: 返回 一 个 Range 对 象 。 该 属性 代表 指定 工作 表 中 的 所 有 行 ， 是 行 的 集合 。 使 
用 该 属性 可 以 访问 具体 的 行 。 

ScrollArea: 以 Al 样式 的 区 域 引用 形式 返回 或 设置 允许 滚动 的 区 域 。 用 户 不 能 选 定 
滚动 区 域 之 外 的 单元 格 。 

UsedRange: 返回 一 个 Range 对 象 ， 该 对 象 表示 指定 工作 表 上 所 使 用 的 区 域 。 
Visible: 返回 或 设置 一 个 XISheetVisibility 值 ， 该 属性 确定 对 象 是 否 可 见 。 


口 口 


DOOOOODODODD 


口 


口 
口 
3.4.2 ”Worksheet 对 象 常用 方法 


Worksheet 对 象 的 常用 方法 如 下 。 

Activate: 使 当前 工作 表 成 为 活动 工作 表 。 

Copy: 将 工作 表 复 制 到 工作 矫 的 另 一 位 置 。 

Delete: 删除 对 象 。 

Move: 将 工作 表 移 到 工作 秒 中 的 其 他 位 置 。 

Paste: 将 “剪贴 板 ” 中 的 内 容 粘贴 到 工作 表 上 。 

PasteSpecial: 以 指定 格式 将 剪贴 板 中 的 内 容 粘 贴 到 工作 表 上 。 可 用 本 方法 从 其 他 应 
用 程序 中 粘贴 数据 ， 或 以 特定 格式 粘贴 数据 。 

口 “PrintOut: 打印 对 象 。 

口 “PrintPreview: 按 对 象 打印 后 的 外 观 效果 显示 对 象 的 预览 。 
口 ”Protect: 保护 工作 表 使 其 不 能 被 修改 。 
口 
口 
口 


SaveAs: 将 对 图 表 或 工作 表 的 更 改 保存 到 另 一 个 文件 中 。 
Select: 选择 对 象 。 
ShowAllData: 使 当前 筛选 列表 的 所 有 行 均 可 见 。 如 果 正 在 使 用 自动 筛选 ， 则 本 方法 
将 下 拉 列 表 框 内 容 改 为 “(全 部 ) ”。 

口 Unprotect: 取消 工作 表 或 工作 短 的 保护 。 如 果 工 作 表 或 工作 短 不 是 受 保护 的 ， 则 此 
方法 不 起 作用 。 
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3.5 Range 对 象 


Range 对 象 是 一 单元 格 区 域 。 这 个 区 域 可 以 是 一 个 单元 格 、 某 一 行 、 某 一 列 或 任意 指定 
单元 格 区 域 。 在 VBA 代码 中 可 以 通过 在 Range 对 象 中 指定 单元 格 的 坐标 来 访问 某 个 具体 的 单 


元 格 。 


3.5.1 


Range 对 象 的 引用 方式 


在 Excel VBA 中 ， 有 很 多 种 方法 实现 对 Range 对 象 的 引用 。 以 下 是 常用 的 方式 。 


OOOODOD 


3.5.2 


单元 格 坐 标 : 例如 Range("A1") 或 Range("A1:E10")。 

Cells 集合 : 例如 Cells(4,5)。 

ActiveCell: 访问 当前 活动 单元 格 。 

Selection: 访问 当前 选 定 的 单元 格 区 域 。 

单元 格 名 称 : 首先 命名 单元 格 区 域 ， 然 后 利用 该 名 称 访问 。 例 如 Range(" 数 据 区 域 ")。 


Range 对 象 常用 属性 


Range 对 象 常 用 属性 如 下 : 


口 
加 


口 


Address: 返回 单元 格 区 域 引用 的 地 址 。 

Borders: 返回 一 个 Borders 集合 。 该 属性 代表 样式 或 单元 格 区 域 (包括 定义 为 条 件 格 
式 的 区 域 ) 的 边框 。 

Characters: 返回 一 个 Characters 对 象 。 该 属性 代表 对 象 文 本 内 某 个 区 域 的 字符 。 使 
用 该 对 象 可 为 文本 字符 串 内 的 字符 设置 格式 。 

Column: 返回 指定 区 域 中 第 一 块 的 第 一 列 的 列 号 。 

Count: 返回 Range 对 象 中 单元 格 的 数量 。 

CountLarge: 返回 Range 区 域 中 的 最 大 值 。 

CurrentRegion: 返回 当前 区 域 中 以 空 行 与 空 列 的 组 合 为 边界 的 区 域 。 

End: 返回 一 个 Range 对 象 ， 该 对 象 代表 包含 源 区 域 的 区 域 尾 端的 单元 格 。 等 同 于 按 
组 合 键 Ctrl+ 向 上 键 、Ctrl+ 向 下 键 、Ctrl+ 疝 左 键 或 Ctrl+ 向 右键 。 

EntireColumn: 返回 指定 区 域 的 整 列 〈 或 多 列 ) Range 对 象 。 

EntireRow: 返回 指定 区 域 的 整 行 (或 多 行 ) Range 对 象 

Font: 返回 一 个 Font 对 象 ， 该 属性 代表 Range 对 象 的 字体 。 

Formula: 返回 或 设置 一 个 Variant 值 ， 该 属性 代表 Al 样式 表示 法 的 单元 格 的 公式 。 
Interior: 返回 一 个 Interior 对 象 ， 该 属性 代表 指定 单元 格 的 内 部 。 

Offset: 返回 一 个 Range 对 象 ， 该 属性 代表 位 于 指定 单元 格 区 域 的 一 定 的 偏 移 量 位 置 
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上 的 区 域 。 
口 Resize: 调整 指定 区 域 的 大 小 。 返 回 一 个 Range 对 象 ， 该 对 象 代表 调整 后 的 区 域 。 
口 Row: 返回 区 域 中 第 一 个 子 区 域 的 第 一 行 的 行 号 。 
口 Rows: 返回 一 个 Range 对 象 ， 该 属性 代表 指定 单元 格 区 域 中 的 行 。 
口 Text: 返回 或 设置 指定 对 象 中 的 文本 。 


3.5.3 ”Range 对 象 常用 方法 


Range 对 象 常用 方法 如 下 : 
口 Activate: 激活 单个 单元 格 ， 该 单元 格 必须 处 于 当前 选 定 区 域内 。 
口 AdvancedFilter: 基于 条 件 区 域 从 列表 中 筛选 或 复制 数据 。 如 果 初 始 选 定 区 域 为 单个 
单元 格 ， 则 使 用 单元 格 的 当前 区 域 。 
AutoFill: 对 指定 区 域 中 的 单元 格 执行 自动 填充 。 
AutoFilter， 使 用 “自动 筛选 ”筛选 一 个 列表 。 
AutoFit 更 改 区 域 中 的 列 宽 或 行 高 以 达到 最 佳 匹 配 。 
Clear: 清除 整个 对 象 。 
Copy: 将 单元 格 区 域 复制 到 指定 的 区 域 或 剪贴 板 中 。 
CopyFromRecordset: 将 ADO 或 DAO Recordset 对 象 中 的 内 容 复制 到 工作 表 ， 从 指定 
区 域 的 左上 角 开始 。 如 果 Recordset 对 象 包含 具有 OLE 对 象 的 字段 ， 则 该 方法 无 效 。 
Cut: 将 对 象 剪 切 到 剪贴 板 ， 或 者 将 其 粘贴 到 指定 的 目的 地 。 
Delete: 删除 对 象 。 
Find: 在 区 域 中 查找 特定 信息 。 
Merge: 由 指定 的 Range 对 象 创建 合并 单元 格 。 
PasteSpecial: 将 Range 对 象 从 剪贴 板 粘贴 到 指定 的 区 域 中 。 
Select: 选择 对 象 。 
Sort: 对 值 区 域 进行 排序 。 
SpecialCells: 返回 一 个 Range 对 象 ， 该 对 象 代表 与 指定 类 型 和 值 匹 配 的 所 有 单元 格 。 
UnMerge: 将 合并 区 域 分 解 为 独立 的 单元 格 。 
以 上 是 部 分 常用 的 方法 ， 所 涉及 的 所 有 对 象 的 属性 和 方法 还 有 很 多 ， 限 于 篇 幅 ， 不 再 一 
一 列 出 。 


OOOOODO 
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简单 实例 


客户 管理 系统 

学 生成 绩 管 理 系 统 
国定 资产 管理 系统 

更 销 存 管理 系统 
员工 管理 系统 

商场 销售 数据 管理 系统 


从 本 篇 开始 ， 将 正式 讲解 Excel 2007 VBA 开发 实例 。 本 篇 主要 讲解 简单 
的 单 实例 。 定 义 为 简单 实例 ， 是 因为 本 篇 的 实例 所 用 到 的 表 、 窗 体 、 模 块 数 
量 并 不 多 。 建 议 读 者 循序 渐进 ， 在 进入 本 篇 学 习 时 ， 每 阅读 一 个 实例 ， 可 以 


考虑 自己 独立 开发 一 个 相应 实例 应 用 。 
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客户 资源 对 于 一 个 企业 十 分 重要 ， 客 户 资料 管理 是 企业 日 常 管理 的 重要 部 分 。 通 常 该 管 
理 系 统 被 集成 在 中 小 型 企业 管理 系统 中 。 本 章 所 介绍 的 客户 管理 系统 是 一 个 独立 的 部 分 ， 因 
此 并 不 涉及 客户 管理 与 其 他 企业 内 部 管理 相互 关联 的 环节 。 该 实例 仅 完成 客户 资料 的 建立 、 
查询 、 修 改 、 删 除 以 及 打印 的 任务 。 内 容 上 有 些 类 似 第 8 章 的 人 事 管理 系统 ， 但 本 例 使 用 的 
是 窗 体 ， 而 人 事 系 统 则 是 用 Excel 2007 本 身 的 功能 实现 的 。 在 开发 方式 上 各 有 所 长 ， 读 者 可 
以 比较 参考 阅读 。 


4.1 系统 概述 


本 实例 将 客户 资料 管理 从 企业 管理 系统 中 独立 出 来 ， 缺 少 了 与 企业 管理 系统 中 其 他 功能 
模块 间 的 相互 联系 的 部 分 ， 因 而 结构 比较 简单 。 本 实例 的 功能 主要 包括 客户 资料 基本 管理 ( 建 
立 、 查 询 、 修 改 和 删除 操作 ) 以 及 打印 工作 。 本 章 的 重点 是 窗 体 开 发 。 


4.1.1 设计 思路 


本 系统 是 一 个 独立 的 、 单 一 的 客户 资料 管理 系统 ， 完 成 最 基本 的 客户 资料 建立 、 编 辑 、 
删除 操作 以 及 打印 工作 。 系 统 使 用 了 两 个 工作 表 : 首页 工作 表 与 客户 表 。 首 页 工作 表 完 成 跳 
转 任务 ， 客 户 表 存储 客户 资料 信息 。 在 实例 的 主 界面 ， 设 计 了 3 个 跳 转 按钮 ， 分 别 完 成 客户 
资料 管理 、 客 户 资料 打印 以 及 退出 系统 功能 。 

各 模块 的 功能 介绍 如 下 : 

1. 客户 资料 管理 

该 模块 主要 用 于 完成 客户 资料 的 添加 、 编 辑 和 删除 操作 。 为 了 便于 对 记录 进行 修改 ， 还 
设计 了 用 于 浏览 的 功能 、 查 询 修 改 和 查询 删除 功能 。 在 该 界面 下 可 以 很 方便 地 建立 客户 的 资 
料 信息 。 

2. 客户 资料 查询 导出 

该 模块 用 于 完成 对 客户 资料 的 查询 与 导出 工作 。 查 询 客 户 资料 信息 时 ， 可 以 按照 客户 的 
全 名 称 、 名 称 缩写 和 名 称 拼 音 等 进行 查询 。 查 询 获得 的 结果 将 会 立即 显示 在 ListView 控件 中 。 
需要 保存 查询 结果 时 ， 可 以 单 击 【输出 报表 】 按 钮 ， 该 按钮 将 查询 结果 重新 保存 到 一 个 新 的 
工作 敌 中 ， 完 成 导出 数据 功能 。 


4.1.2 ”知识 点 一 : 显示 【开发 工具 】 选 项 卡 


_ 
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在 Excel VBA 开发 时 ， 经常 需要 从 Excel 2007 操作 界面 跳 转 到 VBE 环境 。 有 时 候 需要 在 
Excel 2007 工作 表 中 插入 ActiveX 控件 或 进入 编辑 模式 对 工作 表 中 添加 的 控件 进行 编辑 ， 此 时 
就 需要 将 开发 工具 选项 卡 显 示 出 来 。 默 认 情 况 下 ，Excel 并 没有 将 开发 工具 选项 卡 显示 出 来 。 


要 实现 该 目的 操作 步骤 如 下 : 


(1) 首先 选择 Excel 2007 左上 角 的 应 用 程序 图 标 ， 此 时 将 会 显示 Excel 2007 的 系统 菜单 


窗口 ， 如 图 4-1 所 示 。 


BB): Book1 - Microsoft Excel 
最 近 使 用 的 文档 

1 Aplxsm 

2 动态 全 建 用 户 醒 体 APlxlsm 


3 APl 应 用 xlsm 
4 UistViewxlsm 


， ls 


§ XMLSVBAxsm 


» 了 XMLSVBAxml 


Ed 


» 9 XMLSVBAsx 


lsx 
正则 可 达 式 xlsm 
GMenuxls 

ES 

ls 
公式 沪 当 加 wjam 
测试 sx 

抽 有 VBA 代码 xlsm 


放下 [宣王 二 区 考证 出世 二 二 1 二 二 二 二 | 齐 2 生 < 玫 


图 4-1 Excel 2007 系统 菜单 窗口 
(2) 随后 单 击 【Excel 选项 】 按 钮 ， 将 会 显示 【Excel 选项 】 对 话 框 ， 如 图 4-2 所 示 。 


图 4-2 


【Excel 选项 】 对 话 框 


(3) 在 【Excel 选项 】 对 话 框 的 左 侧 选 择 【 常 用 】 选 项 。 然 后 选中 右 侧 的 【在 功能 区 显 
示 “ 开 发 工具 ”选项 卡 】 复 选 框 ， 如 图 4-2 所 示 。 最 后 单 击 【 确 认 】 按 钮 ， 此 时 【开发 工具 】 
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图 4-3 【开发 工具 】 选 项 卡 


4.1.3 ”知识 点 二 : 开启 有 代码 的 工作 敌 


在 Excel 2007 中 打开 包含 VBA 代码 的 工作 短 时 ， 一 般 都 会 询问 是 否 开 启 工 作 短 的 宏 。 如 
果 用 户 需要 开启 该 工作 德 中 的 宏 代码 ， 必 须 选 择 启用 宏 选 项 ， 否 则 工作 德 中 的 宏 代码 将 不 会 
发 生 任何 作用 。 要 打开 该 选项 ， 可 以 依照 以 下 步骤 开启 : 

(1) 按 Ctrlto 组 合 键 ， 在 随后 显示 的 【打开 】 对 话 框 中 选择 任意 一 个 包含 VBA 代码 的 
工作 夭 文 件 。 本 书 所 有 的 实例 工作 德 都 是 包含 宏 的 工作 短 ， 并 保存 为 XLSM 格式 的 工作 乔 
文件 。 

(2) 开启 工作 敌后 ， 在 Excel 2007 标题 栏 下 方 将 会 显示 “ 避 站 上 goaeoasn CBD 
【安全 警告 】 选 项 设置 栏 ， 如 图 4.4 所 示 。 单 击 【选项 】 按 钮 ， 0 
随后 将 显示 【安全 选项 】 设 置 窗口 ， 如 图 4-5 所 示 。 然 后 选中 图 44 安全 警告 选项 设置 
【启用 此 内 容 】 单 选 按钮 ， 单 击 【 确 认 】 按 钮 即 可 。 有 的 工作 表 在 开启 时 ， 会 直接 显示 【 安 
全 声明 】 窗 口 ， 如 图 4-6 所 示 ， 在 该 窗口 中 单 击 【启用 宏 】 按 钮 即 可 。 
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图 4-5 启动 宏 设置 


图 4-6 启用 宏 
42 首页 设计 


首页 工作 表 是 该 实例 的 操作 界面 ， 本 节 介绍 该 工作 表 的 设计 过 程 。 主 要 设计 内 容 包括 界 
面 设计 过 程 、 跳 转 按 钮 代码 与 按钮 效果 代码 设计 。 首 页 的 界面 效果 如 图 4-7 所 示 。 
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图 4-7 首页 界面 效果 图 
首页 所 使 用 到 的 设计 元 素 详细 情况 如 表 4-1 所 示 。 
表 4-1 首页 组 成 元 素 列表 


名 称 图 示 说 了 明 
有 插入 图 片 ， 用 于 首页 界面 装饰 。 该 图 片 将 被 复制 两 次 ， 调 整 大 小 

wi 图 后 ， 重 项 放 竹 
标题 装饰 图 片 | 人 6) 插入 图 片 ， 用 于 点 级 首页 界面 外 观 。 插 入 在 标题 前 
水 平 线 直线 ， 用 于 分 割 各 个 功能 按钮 
圆 头 坚 线 | 直线 ， 用 于 对 齐 各 个 功能 跳 转 按钮 
首页 标题 客户 管理 系统 文本 ， 首 页 的 标题 
跳 转 按钮 容 户 资料 管理 标签 窗 体 控件 ， 用 于 设计 各 个 跳 转 按钮 


4.2.1 首页 界面 设计 


首页 的 详细 设计 过 程 如 下 : 

(1) 插入 人 物 图 片 。 依 次 在 Excel 2007 中 选择 【插入 】| 【图 片 】 命令 (如 图 4-8 所 示 ) 。 
在 打开 的 【插入 图 片 】 对 话 框 中 选择 “人 物 图 片 .bmp” 位 图 文件 。 然 后 单 击 【 插 入 】 按 钮 即 
可 将 该 图 插入 首页 工作 表 。 该 位 图 可 以 在 “第 4 章 ” 文 件 目 录 下 找到 。 
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4-8 插入 图 片 操作 示意 图 
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(2) 复制 人 物 图 片 。 单 击 选中 已 插入 的 “人 物 图 片 ”， 随 后 右 击 该 图 片 ， 在 弹出 的 快捷 
菜单 中 选择 【复制 】 命 令 或 直接 按 下 Ctrl+C 键 复 制 该 图 片 。 如 图 4-9 所 示 。 

(3) 在 “首页 ”工作 表 空 白 处 右 击 鼠 标 ， 在 弹出 的 快捷 菜单 中 选择 【粘贴 】 命 令 或 按 
Ctrl+V 组 合 键 粘贴 图 片 到 该 位 置 。 按 照 本 操作 步骤 再 将 “人 物 图 片 ” 复 制 一 份 即 可 。 

(4) 编辑 人 物 图 片 格式 。 右 击 某 一 “人 物 图 片 ”， 在 弹出 的 快捷 菜单 中 选择 【大 小 和 属 
性 】 命 令 ， 打开 【大 小 和 属性 】 对 话 框 。 将 【高 度 】 和 【宽度 】 文 本 框 中 的 百分比 均 修 改 为 
“47%”， 如 图 4-10 所 示 。 与 次 类 似 ， 再 对 其 他 两 “人 物 图 片 ”的 大 小 与 属性 进行 设置 。 其 
设置 值 如 表 4-2 所 示 。 


下 到 
医 天 | 属性 | 可 选 文字 | 
尺寸 第 畦 一 一 一 一 一 一 一 一 一 一 一 
fr 高 度 外 ， 忆 .6 草 米 光 宽度 WW; 尼 .57 砷 和 可 
¥% | UD | 
Lt 
\ | 
掺 钙 定 肉 模 比 () 
区 eG 厅 相对 于 图 片 原始 尺寸 名) 
强 本 于 项 号 R) ) 
ej 去 惠 米 光 上 3)” 三 硬 末 当 
加 2 者 @， FE 习 下 如 FE 习 
色 is- SS === 
揪 定 坪 (N)-。 丙 放 :7.64 厘米 宽度 :5.44 大 米 
ee 
多 FIESO). 
图 4-9 【图 片 】 快 捷 菜单 图 4-10 图 片 的 大 小 与 属性 设置 


表 4-2 “人 物 图 片 ”的 大 小 与 属性 缩放 比例 设置 


(5) 调整 人 物 图 片 间 位 置 关系 。 右 击 缩放 比例 为 47% 的 “人 物 图 片 ”， 在 弹出 的 快捷 菜 
单 中 选择 【 置 于 顶层】 命令 。 然 后 拖 动 该 图 片 至 3 个 图 片 的 最 上 方 。 对 缩放 比例 为 90% 的 “人 
物 图 片 ”实施 类 似 的 操作 。 只 是 此 时 应 该 选择 【 置 于 底层 】 命 令 且 使 其 位 于 3 个 图 片 的 最 下 
方 。 最 终 3 个 人 物 图 片 的 缩放 比例 及 位 置 关系 如 图 4-7 所 示 。 

(6) 插入 标题 装饰 图 。 在 Excel 2007 中 选择 【插入 】| 【图 片 】 命 令 ， 如 图 4-8 所 示 。 在 
随后 显示 的 【插入 图 片 】 对 话 框 中 选择 “装饰 图 .bmp” 位 图 文件 。 然 后 单 击 【 插 入 】 按 钮 即 
可 将 该 图 插入 首页 工作 表 。 该 位 图 可 以 在 “第 4 章 ” 文 件 目录 下 找到 。 

(7) 添加 水 平 线 。 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】 命 令 ， 如 图 4-11 所 示 。 
随后 在 【线条 】 分 类 栏 中 选择 【直线 】 选 项 。 在 首页 工作 表 中 空白 处 按 住 鼠 标 左 键 不 放 并 水 
平 拖 动 鼠 标 ， 即 可 产生 一 水 平 线 。 在 水 平 拖 动 的 同时 按 住 Shift 键 可 保证 产生 一 绝对 水 平 的 直 
线 。 依 照 此 操作 再 次 绘制 其 他 两 条 水 平 线 。 
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图 4-11 插入 形状 操作 示意 图 


(8) 设置 水 平 线 。 右 击 第 一 条 直线 ， 在 弹出 的 快捷 菜单 中 选择 【大 小 和 属性 】 命 令 ， 打 
开 【 大 小 和 属性 】 对 话 框 。 在 【大 小 和 属性 】 对 话 框 中 将 尺寸 和 旋转 分 类 中 的 【宽度 】 和 【高 
度 】 文 本 框 均 修改 为 28.89 厘米 。 依 照 此 方法 设置 另外 两 条 直线 的 宽度 为 10 厘米 。 

(9) 调整 水 平 线 位 置 。 单 击 第 一 条 水 平 线 不 动 并 拖 动 该 水 平 线 。 将 其 起 始 位 置 拖 动 到 第 
一 个 人 物 图 片 的 中 部 、 首 页 标题 下 方 。 最 终 位 置 如 图 4-7 所 示 。 

(10) 插入 垂直 线 。 在 Excel 2007 中 依次 选择 【插入 】|【 形 状 】 命 令 ， 如 图 4-11 所 示 。 
随后 在 【线条 】 分 类 栏 中 选择 【直线 】 选 项 。 在 首页 工作 表 中 空白 处 按 住 鼠标 左 键 不 放 并 垂 
直 拖 动 鼠 标 ， 即 可 产生 一 垂直 线 。 在 垂直 拖 动 的 同时 按 住 Shift 键 可 以 保证 产生 绝对 垂直 线 。 

(11) 设置 垂直 线 格式 。 右 击 垂直 线 ， 在 弹出 的 快捷 菜单 中 选择 【设置 形状 格式 】 命 令 ， 
打开 【设置 形状 格式 】 对 话 框 。 在 对 话 框 左 侧 的 选项 卡 列表 中 选择 【 线 型 】 选 项 卡 ， 如 图 4-13 
所 示 。 然 后 在 右 侧 选项 设置 栏 中 ， 选 择 【 箭 头 设置 】 的 【后 端 类 型 】 中 的 【钻石 形 箭头 】 样 
式 ， 如 图 4-12 所 示 。 此 处 只 需要 尾 端 呈现 钻石 形状 ， 具 体 的 效果 见 表 4-1 中 的 实例 图 片 。 然 


后 复制 该 垂直 线 两 次 即 可 。 
[amratz x 
一 -本 —> 
> 
图 4-12 ”箭头 类 型 设置 图 4-13 设置 形状 格式 窗 体 


(12) 调整 垂直 线 位 置 。 这 里 只 需要 将 3 个 垂直 线 的 首尾 相连 即 可 。 首 先 单 击 第 二 个 垂 
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直线 不 放 并 拖 动 ， 让 其 头 部 与 第 一 个 垂直 线 的 尾 端 重合 。 读 者 可 以 使 用 方向 键 对 移动 进行 微 
量 调整 。 与 此 类 似 ， 将 第 3 条 垂直 线 的 头 部 与 第 2 条 垂直 线 的 尾 端 重合 。 调 整 好 后 ， 按 住 Ctrl 
键 依次 选中 所 有 垂直 线 ， 然 后 将 所 有 垂直 线 的 位 置 调 整 成 图 4-7 所 示 效 果 。 

(13) 添加 标题 文本 。 在 Excel 2007 中 依次 选择 【插入 】| 【文本 框 】|【 横 排 文 本 框 】 命 
令 ， 如 图 4-14 所 示 。 然 后 在 插入 的 “装饰 图 ”图 片 后 的 空白 处 单 击 鼠 标 左 键 ， 产 生 一 文本 框 。 
随后 在 该 文本 框 中 输入 文字 内 容 “ 客 户 管理 系统 ”。 


的 回 习 [Ea 才 户 管理 系统 Wsm - Microsoft Excel 符 到 工具 9 
> - 一 二 次 加 -ox 
3 | i 本 | 
EN A 弄 a | 
次 后 。 过 图片 莫 由 画 形状 SmartArt 性 形 要 折线 于 饭 权 条 形 轩 机 时 天 点 加 其 他 于 表 直接 9 符号 - 
要 揪 图 Ea 到 文 二 笨 了 条 号 
Line 6 £ 日 
国王” B c D E 下 6 且 I sl K L A 
1 
可 
四 ， 《全 客户 管理 系统 
TEN 首页 | 
Te [EE 本 5 5 


图 4-14 插入 文本 框 操作 示意 图 


(14) 设置 文本 框 格式 。 选 中 步骤 〈12) 创建 文本 框 中 的 所 有 文字 内 容 。 此 时 在 选中 文 
字 的 周围 将 显示 文本 格式 设置 工具 栏 , 如 图 4-15 所 示 。 在 工具 栏 中 设置 其 字体 为 “华文 楷体 ”， 
字号 为 20， 加 粗 ， 居 中 对 齐 格式 。 最 终 效果 如 图 4-7 所 示 。 

(15) 创建 功能 按钮 。 在 Excel 2007 中 依次 选择 【开发 工具 】| 【控件 】|【 插 入】 命令 ， 
在 ActiveX 控件 列表 中 选择 标签 控件 ， 如 图 4-16 所 示 。 


图 4-15 文本 设置 工具 栏 图 4-16 插入 控件 


(16) 设置 功能 按钮 格式 。 右 击 刚 创建 的 标签 控件 ， 在 弹出 的 快捷 菜单 中 选择 【属性 】 
命令 , 打开 【属性 ] 窗 口 。 然 后 将 该 标签 控件 的 名 称 修改 为 “Label 客户 管理 ”。 随后 将 其 Caption 
属性 修改 为 “客户 资料 管理 ”。 然 后 选择 【 按 分 类 序 】 选 项 卡 将 属性 按 分 类 排序 ， 如 图 4-17 
所 示 。 在 【杂项 】 分 类 中 设置 该 标签 控件 的 Height 和 Width 属性 分 别 为 26.75 和 175.5。 然 后 
通过 复制 与 粘贴 命令 将 该 标签 控件 复制 两 份 。 分 别 将 它们 的 名 称 修改 为 “Label 客户 资料 查询 
导出 ”和 “Label 退出 ”。Caption 依次 为 “客户 资料 查询 导出 ”和 “退出 ”。 

(17) 调整 功能 按钮 的 位 置 。 将 3 个 按钮 依次 拖 入 由 垂直 线 和 水 平 线 构成 的 方 框 中 。 可 
以 通过 上 下 左右 方向 键 控制 移动 的 精度 。 最 终 效果 如 图 4-7 所 示 。 
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图 4-17 设置 客户 资料 管理 标签 控件 
4.2.2 ”标签 控件 显示 效果 变化 代码 


首页 工作 表 中 的 代码 其 实现 的 主要 功能 包括 两 部 分 ， 分 别 是 鼠标 滑动 时 标签 控件 的 显示 
效果 变化 以 及 标签 控件 的 跳 转 。 本 小 节 介绍 的 是 标签 控件 显示 效果 变化 代码 。 

该 部 分 代码 实现 的 是 一 种 标签 突出 显示 效果 。 该 代码 可 以 对 当前 鼠标 所 指向 的 标签 控件 
进行 突出 显示 ， 以 达到 提示 作用 。 其 实现 方法 是 : 在 3 个 标签 控件 的 MouseMove 事件 过 程 中 ， 
分 别 执行 一 个 共同 的 过 程 ChangeFace。 该 过 程 根据 传递 的 参数 ， 判 断 具 体 应 该 对 哪 一 个 标签 
控件 进行 操作 ， 然 后 修改 该 标签 控件 的 状态 。 

标签 控件 的 状态 变化 过 程 如 下 : 当 鼠 标 在 3 个 标签 控件 间 滑 动 时 ， 鼠 标 当前 指向 的 标签 
控件 的 背景 色 被 修改 为 &HE0E0E0， 其 字号 被 修改 为 16。 而 未 被 鼠标 指向 的 其 他 标签 控件 的 
显示 状态 将 被 复原 。 该 效果 的 实现 代码 如 下 : 

Option Explicit 

' 该 过 程 依次 检测 3 个 标签 控件 ， 并 修改 当前 鼠标 所 指向 的 标签 的 显示 状态 


' 当 不 是 指定 的 标签 时 ， 将 该 标签 的 显示 状态 复原 
Private Sub ChangeFace(strName As String) 


If strName = "客户 管理 " Then "检测 所 操作 的 标签 是 否 是 客户 资料 管理 标签 
' 突 出 显示 客户 资料 管理 标签 控件 
With Label 客户 资料 管理 
.Font Size = 16 ' 修 改 标签 控件 的 字体 大 小 
.BackColor = &HEOEOEO ' 修 改 标签 控件 的 背景 色 
End With 
Else 
"复原 客户 管理 标签 控件 显示 状态 
With Label 客户 资料 管理 
.Font.Size = 14 "修改 标签 控件 的 字体 大 小 
.BackColor = &H80000005 ' 修 改 标签 控件 的 背景 色 
End With 
End If 
If strName = "客户 资料 查询 导出 " Then ' 检 测 所 操作 的 标签 是 否 是 客户 资料 查询 导出 标签 
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' 突 出 显示 客户 资料 查询 导出 标签 控件 
With Label 客户 资料 查询 导出 
.Font.Size = 16 路 改 标签 控 件 的 字体 大 小 
.BackColor = &HEOEOEO ' 修 改 标签 控件 的 背景 色 
End With 
Else 


' 复 原 客户 资料 查询 导出 标签 控件 显示 状态 
With Label 客户 资料 查询 导出 


.Font.Size = 14 ' 修 改 标签 控件 的 字体 大 小 
.BackColor = &H80000005 路 改 标签 控件 的 背景 色 
End With 
End If 
If strName = "退出 "Then ' 检 测 所 操作 标签 是 否 是 退出 标签 
' 突 出 显示 退出 标签 控件 
With Label 退出 
.Font.Size = 16 路 改 标签 控件 的 字体 大 小 
.BackColor = &HEOEOEO ' 修 改 标签 控件 的 背景 色 
End With 
Else 
"复原 退出 标签 控件 显示 状态 
With Label 退出 
.Font.Size = 14 路 改 标签 控件 的 字体 大 小 
.BackColor = &H80000005 路 改 标签 控件 的 背景 色 
End With 
End If 
End Sub 


' 当 鼠标 在 客户 资料 管理 标签 上 移动 时 ， 执 行 该 事件 过 程 

Private Sub Label 客户 资料 管理 _MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal 
X As Single, ByVal Y As Single) 

ChangeFace "客户 资料 管理 " ' 调 用 ChangeFace 过 程 ， 改 变 客户 资料 管理 标签 的 显示 状态 

End Sub 


' 当 鼠标 在 客户 资料 查询 导出 标签 上 移动 时 ， 执 行 该 事件 过 程 

Private Sub Label 客户 资料 查询 导出 _MouseMove(ByVal Button As Integer, ByVal Shift As Integer, 
ByVal X As Single, ByVal Y As Single) 

ChangeFace "客户 资料 查询 导出 " “' 调 用 ChangeFace 过 程 ， 改 变 客户 资料 查询 导出 标签 的 显示 状态 
End Sub 


' 当 鼠标 在 退出 标签 控件 上 移动 时 ， 执 行 该 事件 过 程 

Private Sub Label 退出 _MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As 
Single, ByVal Y As Single) 

ChangeFace "退出 " ' 调 用 ChangeFace 过 程 ， 改 变 退 出 标签 的 显示 状态 

End Sub 


4.2.3 标签 单 击 事件 代码 


该 段 代码 实现 首页 的 跳 转 功 能 。 当 在 首页 工作 表 的 各 个 标签 上 单 击 时 ， 将 执行 相应 的 标 
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签 的 Click 事件 过 程 代码 ， 从 而 激发 相应 的 功能 。 

首页 中 包含 了 3 个 标签 ， 分 别 是 客户 资料 管理 标签 、 客 户 资料 查询 导出 标签 和 退出 标签 。 
单 击 客户 资料 管理 标签 控件 将 显示 客户 信息 管理 窗 体 ， 单 击 客户 资料 查询 导出 标签 将 显示 客 
户 资料 查询 导出 窗 体 ， 单 击 退 出 标签 将 保存 工作 敌后 退出 该 工作 簿 。 以 下 是 该 代码 块 的 代码 


解释 : 

Private Sub Label 客户 资料 管理 _Click() 

客户 信息 管理 .Show ' 显 示 客 户 信息 管 理 窗 体 

End Sub 

Private Sub Label 客户 资料 查询 导出 _Click() 

客户 资料 查询 导出 .Show ' 显 示 客 户 资料 查询 导出 窗 体 

End Sub 

Private Sub Label 退出 _Click() 

With ThisWorkbook 
.Save 保存 当前 工作 往 
.Close 关闭 当前 工作 简 

End With 

End Sub 


4.3 ”客户 资源 管理 窗 体 设计 


客户 资源 管理 的 功能 在 客户 资源 管理 窗 体 中 完成 。 该 窗口 主要 完成 客户 资料 的 添加 、 查 
找 、 修 改 、 删 除 以 及 记录 的 浏览 工作 。 使 用 查找 功能 可 以 快速 定位 需要 修改 和 删除 的 客户 记 
录 。 窗 体 中 用 于 浏览 记录 的 按钮 比较 多 ， 用 户 可 以 选择 的 浏览 方式 也 可 以 分 为 两 种 ， 一 种 是 
通过 【查看 客户 】 表 按钮 一 次 性 查看 所 有 客户 记录 ; 另 一 种 是 通过 【 首 条 】、【 上 一 条 】、 
【下 一 条 】 和 【最 后 】 按 钮 一 条 一 条 地 在 窗 体 中 浏览 客户 记录 。 客 户 信息 管理 窗 体 的 界面 如 
图 4-18 所 示 。 


EEEEEEEE3 
一 次 户 信息 资料 


区 


图 4-18 客户 信息 管理 窗 体 
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4.3.1 窗 体 界面 设计 


该 窗 体 的 左 侧 是 客户 信息 资料 显示 与 编辑 区 域 ， 右 侧 是 相应 的 控制 按钮 ， 底 部 是 一 提醒 
信息 标签 。 该 窗 体 的 ShowModal 属性 被 设置 为 Flase， 该 窗 体 为 无 模式 窗口 。 整 个 界面 被 分 割 
为 4 个 部 分 ， 以 下 详细 介绍 。 

1. 客户 信息 资料 

该 部 分 包括 20 个 标签 控件 〈 用 于 提示 相应 的 文本 框 或 复合 框 控件 显示 内 容 ) 、19 个 文本 
框 控 件 〈 显 示 当 前 浏览 的 记录 ， 在 此 可 以 对 该 记录 进行 编辑 ) 和 1 个 复合 框 控件 。 

这 20 个 标签 控件 分 别 用 来 提示 以 下 属性 : 客户 ID、 客户 名 称 、 名 称 缩写 、 负 责 人 、 地 址 、 
邮政 编码 、 城 市 、 地 区 、 国 家 、 电 话 、 传 真 、Email、 网 址 、 经 营 范围 、 客 户 级 别 、 信 用 等 级 、 
联系 人 、 联 系 人 电话 、 联 系 人 Email 和 备注 。 相 应 的 文本 框 和 复合 框 控件 的 Tab 属性 被 设置 为 
该 顺序 ， 并 且 在 客户 资料 表 中 各 个 信息 字段 也 是 按照 这 个 顺序 排列 。 

相应 的 文本 框 和 复合 框 控件 的 SelectionMargin 被 设置 为 False。 当 该 属性 被 设置 为 False 
时 ， 对 应 的 文本 框 和 复合 框 控件 整个 文本 区 域 都 可 以 用 来 显示 和 保存 文本 ， 默 认 情 况 下 的 文 
本 页 边 距 将 被 取消 。 

2， 功能 按钮 区 

该 区 域 包括 新 增 、 查 找 、 修 改 、 删 除 和 退出 5 个 功能 按钮 。 前 4 个 完成 客户 信息 资料 的 
编辑 操作 ， 最 后 一 个 按钮 用 于 退出 窗 体 。 

3. 记录 浏览 按钮 区 

该 区 域 包括 查看 客户 表 、 首 条 、 上 一 条 、 下 一 条 和 最 后 5 个 按钮 。 可 以 通过 该 区 域 的 按 
钮 在 客户 表 中 或 直接 在 窗 体 中 浏览 客户 信息 资料 。 

4. 提示 区 

该 区 域 包括 两 个 标签 控件 ， 其 中 一 个 直接 显示 “提示 : ”， 表 明 该 部 分 用 于 显示 提示 信 
息 ， 另 一 个 动态 提示 当前 浏览 的 记录 在 客户 表 中 的 行 数 〈 并 非 记 录 数 ， 因 为 该 表 还 多 了 一 
标题 ) 。 


4.3.2 ” 窗 体 初始 化 代码 


在 该 窗 体 被 加 载 的 时 候 ， 首 先 需 要 完成 一 些 初始 化 工作 ， 以 保证 窗 体 显 示 工 作 顺 利 完 成 。 
这 些 工作 包括 初始 化 变量 、 初 始 化 复合 框 控 件 、 初 始 化 记录 显示 和 初始 化 浏览 按钮 的 显示 状 
态 。 窗 口 初始 化 的 详细 流程 如 图 4-19 所 示 。 


初始 化 自 定 数组 元 素 


初始 化 地 区 复合 框 项 目 


计算 客户 表 行 数 存 入 rowsCount 


否 


是 
设置 窗 体 文本 框 与 
复合 框 显示 值 


首 条 与 上 一 条 按钮 不 可 用 


下 一 条 与 最 后 按钮 不 可 用 


图 4-19 窗口 初始 化 流程 图 
以 下 是 该 过 程 的 代码 解释 : 
Private Sub UserForm_lnitialize() 
Dim SQL As String 
Dim rowsCount As Integer 
' 初 始 化 变量 
Set ws = Worksheets(" 客 户 表 ") ' 获 取 客户 表 工 作 表 对 象 
myArray = Array(" 客 户 1D", "客户 名 称 ", "名 称 缩写 ", "负责 人 ", "地 址 ", _ 
"邮政 编码 ", "城市 ", "地 区 ", "国家 ", "电话 ", "传真 ", "Email", "网 址 ", _ 
"经 营 范围 ", "客户 级 别 ", "信用 等 级 ", "联系 人 ", "联系 人 电话 ", _ 


"联系 人 Email", "备注 ") ' 初 始 化 数组 元 素 

' 初 始 化 地 区 复合 框 项 目 

With 地 区 
.Addltem "东北 " 为 地 区 复合 框 添加 第 一 个 项 目 
.Addltem "华北 " 为 地 区 复合 框 添加 第 二 个 项 目 
.Addltem "西北 " 为 地 区 复合 框 添加 第 三 个 项 目 
.Addltem "西南 " 为 地 区 复合 框 添加 第 四 个 项 目 
.Addltem "华东 " 为 地 区 复合 框 添加 第 五 个 项 目 
.Addltem "华南 " 为 地 区 复合 框 添加 第 六 个 项 目 
-Listndex= 0 为 地 区 复合 框 添加 第 七 个 项 目 

End With 

"以 下 是 初始 化 记录 显示 代码 


rowsCount = Ws.Range("A" & Rows.Count).End(xIUp).Row ”获取 客户 表 的 有 数据 的 行 数 
' 当 客户 表 中 存在 客户 资料 记录 时 ， 将 第 一 条 显示 在 窗 体 中 


IfrowsCount > 1Then 


With 


End 


Ws 
客户 1D.Text =.Range("A2") 


客户 名 称 .Text =.Range("b2") "设置 客户 名 称 文本 框 显 示 值 
名 称 缩写 .Text =.Range("C2") "设置 名 称 缩写 文本 框 显 示 值 
负责 人 .Text =.Range("d2") "设置 负责 人 文本 框 显示 值 
地 址 .Text =.Range("E2") ' 设 置地 址 文本 框 显示 值 

邮政 编码 .Text =.Range("f2") "设置 邮政 编码 文本 框 显 示 值 
城市 .Text =.Range("g2") ' 设 置 城市 文本 框 显示 值 
地 区 .Text =.Range("H2") "设置 地 区 复合 框 显示 值 

国家 .Text =.Range("i2") "设置 国家 文本 框 显示 值 

电话 .Text =.Range("j2") "设置 电话 文本 框 显示 值 

传真 .Text =.Range("k2") "设置 传真 文本 框 显示 值 
Email.Text =.Range("l27) "设置 Email 文本 框 显示 值 
网 址 .Text =.Range("m2") "设置 网 址 文本 框 显示 值 

经 营 范围 .Text =.Range("n2") "设置 经 营 范 围 文 本 框 显 示 值 
客户 级 别 .Text =.Range("02") "设置 客户 级 别 文本 框 显示 值 
信用 等 级 .Text =.Range("p2") "设置 信用 等 级 文本 框 显示 值 
联系 人 .Text =.Range("q2") "设置 联系 人 文本 框 显示 值 
联系 人 电话 .Text =.Range("r2") "设置 联系 人 电话 文本 框 显示 值 
联系 人 EmailText =.Range("s2") "设置 联系 人 Email 文本 框 显示 值 
备注 .Text =.Range("t2") "设置 备注 文本 框 显示 值 


With 


"设置 客户 ID 文本 框 显示 值 


"显示 记录 为 首 条 时 ， 设 置 首 条 和 上 一 条 按钮 的 状态 为 不 可 用 
首 条 .Enabled = False 

上 一 条 .Enabled = False 
' 当 客户 资料 表 只 有 一 条 客户 资料 时 ， 设 置 下 一 条 和 最 后 按钮 状态 不 可 用 
lfrowsCount = 2 Then 


End 


' 在 提示 中 显示 当前 显示 记录 在 客户 表 中 的 行 数 


下 一 条 .Enabled = False 
最 后 .Enabled = False 
If 


"设置 下 一 条 按钮 不 可 用 
"设置 最 后 按钮 不 可 用 


提示 .Caption = "当前 记录 在 客户 表 中 位 于 第 2 行 " 


Else 


' 当 客户 表 中 不 存在 客户 资料 时 ， 提 示 无 客户 资料 


提示 .Caption = "当前 客户 表 中 还 没有 任何 客户 信息 记录 !" 


End If 
End Sub 


4.3.3 ”新 增 按钮 代码 


在 程序 运行 过 程 中 ，【 新 增 】 按 钮 有 两 种 状态 。 一 种 是 新 增 状态 ， 该 状态 下 单 击 【 新 增 】 
按钮 时 ， 将 会 重 置 所 有 文本 框 和 复合 框 ， 以 便于 新 建 客户 资料 信息 时 的 输入 工作 。 被 选择 后 
该 按钮 的 Caption 属性 将 被 修改 为 添加 。 另 一 种 是 添加 状态 ， 该 状态 下 单 击 【新 增 】 按 钮 将 完 
成 添加 功能 。 因 而 该 按钮 也 包含 了 对 应 的 两 个 功能 ， 一 个 是 新 建 时 的 重 置 功能 ， 一 个 是 再 次 


_ 
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选择 时 的 添加 记录 功能 。 

这 两 种 状态 的 切换 是 由 用 户 选 择 该 按钮 的 次 数 决 定 的 。 当 用 户 选 择 该 按钮 的 次 数 为 偶数 
时 ， 按 钮 处 于 新 增 状 态 ， 当 用 户 选择 该 按钮 的 次 数 为 奇数 时 ， 按 钮 处 于 添加 状态 。 为 了 记录 
用 户 单 击 该 按钮 的 次 数 ， 该 过 程 中 使 用 了 一 个 Static 定义 的 局 部 静态 变量 。 该 过 程 的 流程 如 
图 4-20 所 示 。 


定义 静态 变量 intClickCount 
累计 按钮 单 击 次 数 intClickCount 


IntClickCount 是 否 为 偶数 


是 


添加 按钮 Caption 修 改 为 新 增 
一 一 等 户 信息 没有 空 信息 
是 
向 客户 表 添 加 新 记录 


添加 按钮 Caption 修 
改 为 添加 


重 置 窗口 文本 框 和 复合 框 


图 4-20 【新 增 】 按 钮 单 击 事件 过 程 流程 图 
该 过 程 的 详细 代码 解释 如 下 : 
Private Sub 添加 _Click() 
Dim n As Long, i As Integer 
Static intClickCount As Integer 
intClickCount = intClickCount + 1 


lfintClickCount Mod 2 = 0 Then 
' 单 击 偶数 次 时 ， 执 行 添 加 功能 代码 


添加 .Caption = "新 增 " "修改 按钮 Caption 属性 为 “新 增 ” 
"循环 检测 各 个 文本 框 和 复合 框 控件 
Fori=0ToUBound(myArray) 
上 myArray(i) = "备注 " Then Exit For ' 备 注 项 可 以 为 空 
If Me.Controls(myArray(i)).Value = " Then ' 检 测 其 他 文本 框 和 复合 框 是 否 为 空 
MsgBox myArray(i) & "不 能 为 空 !", vbCritical, "警告 " ' 提 示 项 目 不 能 为 空 
Me.Controls(myArray(i)).SetFocus ' 重 置 鼠 标 焦点 
Exit Sub 
End If 
Next 
n =ws.Range("A65536").End(xIlUp).Row + 1 获取 新 记录 在 客户 表 的 插入 行 行 号 


办公 应 用 沸 党 乞 比 
Excel VBA 应 用 开发 经 典 案例 


Fori= 1 To UBound(myArray)+ 1 


ws.Cells(n, i) = Me.Controls(myArray(i -1)).Value ' 保 存 新 客户 的 信息 到 客户 表 

Next 
ws.Columns.AutoFit ' 客 户 表 各 列 自动 适应 宽度 
MsgBox "客户 信息 添加 成 功 !", vblnformation, "添加 数据 ” ”' 提 示 添 加 客户 信息 成 功 
客户 ID.SetFocus 将 焦点 移 到 客户 ID 文本 框 
地 区 .Listindex =0 ' 设 置地 区 文本 框 的 默认 值 
国家 .Value = "中 国 " ' 设 置 国家 文本 框 的 默认 值 
ThisWorkbook.Save 保存 工作 和 

Else 
' 当 是 奇数 次 单 击 此 按钮 时 ， 执 行 以 下 代码 
添加 .Caption = "添加 " ' 将 按钮 的 Caption 属性 设置 为 添加 

End 上 f 


' 将 窗口 中 的 所 有 文本 框 控件 和 复合 框 控件 重 置 
Fori=oToUBound(myArray)+1 
Me.Controls(myArray(i)).Value = ™ ' 重 置 文 本 框 或 复合 框 
Next 
End Sub 


4.3.4 ”查找 按钮 代码 


当 用 户 使 用 记录 浏览 按钮 浏览 客户 记录 时 ， 只 能 逐个 查看 ， 这 样 的 查看 方式 不 便于 快速 
定位 需要 修改 或 删除 的 客户 记录 。 这 时 可 以 就 使 用 【查找 】 按 钮 完成 该 工作 。 
在 本 窗口 中 的 【查找 】 按 钮 只 支持 对 客户 名 称 的 拼音 检索 ， 并 且 一 定 要 保证 所 输入 的 拼 
是 完全 正确 的 。 当 用 户 单 击 该 按钮 后 ， 将 显示 一 个 输入 框 ， 要 求 输入 客户 名 称 的 汉语 拼音 
头 〈 如 图 4-21 所 示 ) 。 输 入 完成 后 ， 程 序 将 检索 所 有 客户 记录 的 拼音 字 头 。 当 有 符合 条 件 
户 记 录 时 ， 将 在 窗 体 中 将 该 条 客户 记录 显示 出 来 。 


YY 
| 


客 


输入 帮 户 名 称 汉 语 拼音 字 头 | 
记 短 和 要 进行 坎 料 修改 的 客户 各 和 的 汉语 扒 音字 


图 4-21 输入 客户 名 称 拼 音字 头 
该 过 程 中 包含 了 大 量 的 文本 框 和 复合 框 数据 设置 代码 ， 占 用 了 大 量 的 页 面 ， 实 际 上 过 程 
流程 十 分 简单 。 这 里 不 再 将 该 过 程 的 流程 表示 为 图 示 。 下 面 是 单 击 【 查 找 】 按 钮 的 事件 代码 : 

Private Sub 查找 _Click() 
Dim myName As String 

' 输 入 客户 名 称 汉语 拼音 字 头 

myName = InputBox(" 请 输入 要 进行 资料 修改 的 客户 名 称 的 汉语 拼音 字 头 :"，_ 

"输入 客户 名 称 汉语 拼音 字 头 ") 

' 开 始 查询 某 个 客户 

' 检 查 拼 音 函 数 核对 所 有 客户 名 称 的 拼音 字 头 ， 如 果 有 相符 返回 真 ， 否 则 为 假 

"该 函数 的 具体 使 用 和 代码 见 本 节 后 续 文字 


< 
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lf 检查 拼音 (myName) Then 
' 将 查询 到 的 客户 资料 显示 在 窗 体 上 
With Ws 


客户 名 称 .Text = .Range("b" & intRowNow) 设置 客户 名 称 文本 框 显示 值 
名 称 缩写 .Text = .Range("c" & intRowNow) "设置 名 称 缩写 文本 框 显示 值 
负责 人 .Text = .Range("d" & intRowNow) ' 设 置 负责 人 文本 框 显示 值 
地 址 .Text = .Range("E" & intRowNow) "设置 地 址 文本 框 显示 值 
邮政 编码 .Text = .Range("f" & intRowNow) "设置 邮政 编码 文本 框 显示 值 
城市 .Text = .Range("g" & intRowNow) "设置 城市 文本 框 显示 值 
地 区 .Text = .Range("H" & intRowNow) ' 设 置地 区 复合 框 显示 值 
国家 .Text = .Range("i" & intRowNow) ' 设 置 国家 文本 框 显示 值 
电话 .Text = .Range("j" & intRowNow) "设置 电话 文本 框 显示 值 
传真 .Text = .Range("k" & intRowNow) "设置 传真 文本 框 显示 值 
Email.Text = .Range("l" & intRowNow) ' 设 置 Email 文本 框 显示 值 
网 址 .Text = .Range("m" & intRowNow) "设置 网 址 文本 框 显示 值 
经 营 范围 .Text = .Range("n" & intRowNow) "设置 经 营 范围 文本 框 显示 值 
客户 级 别 .Text = .Range("o" & intRowNow) "设置 客户 级 别 文本 框 显示 值 
信用 等 级 .Text = .Range("p" & intRowNow) "设置 信用 等 级 文本 框 显示 值 
联系 人 .Text = .Range("q" & intRowNow) ' 设 置 联系 人 文本 框 显示 值 
联系 人 电话 .Text = .Range("r" & intRowNow) "设置 联系 人 电话 文本 框 显示 值 
联系 人 EmailText = .Range("s" & intRowNow) "设置 联系 人 Email 文本 框 显示 值 
备注 .Text = .Range("t" & intRowNow) ' 设 置 备注 文本 框 显示 值 
End With 
浏览 按钮 状态 路 改 各 个 浏览 按钮 的 可 用 状态 
End ff 
End Sub 
代码 说 明 : 


客户 1D.Text = .Range("a" & intRowNow) 


"设置 客户 ID 文本 框 显 示 值 


口 ”检查 是 否 有 客户 名 称 的 拼音 字 头 与 所 查询 的 相符 ， 使 用 检查 拼音 4 和 拼音 头 字 母 两 个 
函数 。 这 两 个 函数 位 于 该 工程 文件 的 公共 过 程 模块 中 。 这 两 个 函数 的 代码 介绍 请 见 
本 章 的 后 续 内 容 。 

口 “在 该 过 程 中 用 到 了 一 个 模块 变量 intRowNow。 该 变量 在 窗口 代码 头 部 被 定义 ， 窗 口 

中 所 有 的 过 程 和 函数 都 可 以 访问 该 变量 。 该 变量 在 检查 拼音 函数 中 被 修改 ， 用 于 确 

定 查 询 到 的 客户 记录 所 在 行 数 。 


4.3.5 检查 拼音 函数 代码 设计 


检查 拼音 函数 是 通过 使 用 一 个 双重 循环 ， 确 认 在 客户 表 中 是 否 有 当前 客户 名 称 的 拼音 
头 的 客户 记录 。 外 层 循环 检测 遍历 了 客户 表 中 所 有 客户 记录 的 客户 名 称 。 内 层 循环 遍历 某 一 
个 客户 名 称 中 的 所 有 汉字 ， 获 得 客户 名 称 头 字母 。 最 后 将 这 个 客户 名 称 的 拼音 字 头 与 用 户 
入 的 拼音 字 头 加 以 比较 ， 确 认 该 客户 记录 是 否 为 查询 结果 。 该 过 程 的 流程 如 图 4-22 所 示 。 


ES 


初始 化 函数 返回 值 


获取 客户 表 数 据 行 数 intRowsCount 
循环 行 号 二 2 


获取 客户 名 称 字符 
串 长 度 存 入 myLen 


将 第 重 客 户 名 称 字符 串 的 字符 
逐个 存 入 myName 数 组 中 


循环 变量 j=1 


将 第 j 个 字符 的 拼音 连接 
总 拼音 字符 串 myPY 


函数 返回 Tme 


图 4-22 检查 拼音 函数 流程 图 


以 下 为 该 函数 的 代码 : 
Public Function 检查 拼音 (khmc As String, intRowNow As Integer) As Boolean 


Dim myLen As Integer, k As Integer 
Dim intRowsCount As Integer 


检查 拼音 = False "初始 化 函数 返回 值 

“获得 客户 表 有 数据 的 行 数 

intRowsCount = Ws.Range("A" & Rows.Count).End(xIUp).Row 

Fori= 2 To intRowsCount "循环 客户 表 中 所 有 的 客户 记录 行 
"获取 每 个 记录 的 客户 名 称 字符 串 的 长 度 


myLen = Len(Ws.Cells(i, 2)) 
' 将 客户 名 称 的 每 个 汉字 逐个 保存 到 数组 myName 中 


ReDim myName(1 To myLen) As String "重新 设 定数 组 上 下 界 
Forj = 1To myLen 
myName(j) = Mid(Ws.Cells(i, 2), j, 1) ' 将 单个 字符 存储 在 对 应 数组 元 素 中 


Next 


ff 
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"以 下 代码 获取 客户 名 称 的 汉语 拼音 的 第 一 个 字母 
myPY="" ' 重 置 客 户 名 称 字 头 字符 串 
"以 下 循环 遍历 汉字 数组 ， 获 取 每 个 数组 元 素 包含 的 汉字 的 拼音 首 字母 并 
' 把 这 些 首 字母 连接 起 来 ， 保 存在 myPY 字符 串 变 量 里 
Forj = 1 To myLen 
myPY = myPY & 拼音 头 字母 (myName(j)) “将 单个 字符 的 拼音 字 头 连接 到 总 字符 串 


Next 
"判断 是 否 有 复合 条 件 的 客户 记录 
IfLCase(khmc) =LCase(myPY) Then "使 用 Lcase 函数 消除 大 小 写 的 影响 
检查 拼音 = True "标识 结果 被 查询 到 
intRowNow =i "记录 当前 的 行 号 
Exit Function "跳出 函数 
End If 
Next 
MsgBox "没有 符合 条 件 的 客户 资料 ! ", vbCritical, "查询 结果 "” ' 提 示 用 户 没 有 找到 对 应 的 客户 信息 
End Function 


4.3.6 ”拼音 头 字 母 函 数 代 码 设计 


拼音 头 字 母 函数 接受 一 个 汉字 字符 参数 。 函 数 根 据 该 字符 参数 ， 确 定 出 该 汉字 拼音 的 头 
字母 ， 然 后 将 该 汉字 拼音 的 头 字母 作为 结果 返回 。 该 函数 的 结构 十 分 简单 ， 但 是 需要 做 出 的 
判断 比较 多 ， 这 里 不 再 列 出 该 函数 的 流程 图 

该 函数 首先 获取 汉字 字符 参数 的 字符 代码 。 由 于 汉字 在 字符 代码 表 中 是 按照 拼音 的 顺序 
排序 的 ， 在 确认 该 汉字 的 首 字 母 拼音 时 ， 只 需 与 字符 代码 表 中 各 个 分 段 的 起 始 汉 字 的 字符 代 
码 比 较 即 可 。 函 数 中 使 用 了 If…Then…Elself 的 结构 。 

以 下 是 该 函数 的 详细 代码 设计 : 

Public Function 拼音 头 字母 (myChar As String) As String 

Dim i As Long 

i= Asc(myChar) "获取 汉字 参数 的 字符 代码 
"以 下 代码 获取 该 汉字 参数 的 字符 代码 对 应 的 拼音 字母 。 

"汉字 的 字符 代码 的 编排 按照 拼音 字母 顺序 ， 所 以 只 需要 比较 每 个 拼音 字母 的 
"首尾 汉字 的 字符 代码 即 可 得 到 对 应 的 拼音 字母 。 


Ifi >= Asc(" 啊 ") And i < Asc(" 芭 ") Then "检测 i 是 否 落 在 A 首尾 汉字 拼音 字母 间 
拼音 头 字母 = "A" 

Elselfi >= Asc(" 芭 ") And i < Asc(" 擦 ") Then ' 检 测 i 是 否 落 在 B 首尾 汉字 拼音 字母 间 
拼音 头 字母 = "B" 

Elselfi >= Asc(" 擦 ") And i < Asc(" 搭 ") Then "检测 i 是 否 落 在 C 首尾 汉字 拼音 字母 间 
拼音 头 字母 = "C" 

Elselfi >= Asc(" 搭 ") And i < Asc(" 蛾 ") Then "检测 i 是 否 落 在 D 首尾 汉字 拼音 字母 间 
拼音 头 字母 = "D" 

Elselfi >= Asc(" 蛾 " And i < Asc(" 发 ") Then ' 检 测 i 是 否 落 在 E 首尾 汉字 拼音 字母 间 
拼音 头 字母 = "E" 

Elselfi >= Asc(" 发 " And i < Asc(" 嘲 ") Then ' 检 测 i 是 否 落 在 F 首尾 汉字 拼音 字母 间 
拼音 头 字 母 = "F" 

Elselfi >= Asc(" 噶 ") And i < Asc(" 哈 ") Then ' 检 测 i 是 否 落 在 G 首尾 汉字 拼音 字母 间 


拼音 头 字母 = "G" 


beh 


Elselfi >= Asc(" 哈 ") And i < Asc(" 击 ") Then 
拼音 头 字母 = "H" 

Elselfi >= Asc(" 击 ") And i < Asc(" 喀 ") Then 
拼音 头 字母 = "J" 

Elselfi >= Asc(" 喀 ") And i < Asc(" 垃 ") Then 
拼音 头 字 母 = "K" 

Elselfi >= Asc(" 垃 ") And i < Asc(" 妈 ") Then 
拼音 头 字母 = "L" 

Elselfi >= Asc(" 妈 ") And i < Asc(" 拿 ") Then 
拼音 头 字母 = "M" 

Elselfi >= Asc(" 拿 ") And i < Asc(" 哦 ") Then 
拼音 头 字母 = "N" 

Elselfi >= Asc(" 哦 " And i < Asc(" 呈 ") Then 
拼音 头 字母 = "O" 

Elselfi >= Asc(" 哟 ") And i < Asc(" 欺 ") Then 
拼音 头 字母 = "P" 

Elselfi >= Asc(" 欺 ") And i < Asc(" 然 ") Then 
拼音 头 字母 = "Q" 

Elselfi >= Asc(" 然 ") And i < Asc(" 扳 ") Then 
拼音 头 字母 = "R" 

Elselfi >= Asc(" 撒 ") And i < Asc(" 塌 ") Then 
拼音 头 字母 = "S" 

Elselfi >= Asc(" 塌 ") And i < Asc(" 挖 ") Then 
拼音 头 字母 = "T" 

Elselfi >= Asc(" 挖 ") And i < Asc(" 昔 ") Then 
拼音 头 字母 = "W" 

Elselfi >= Asc(" 昔 ") And i < Asc(" 压 ") Then 
拼音 头 字母 = "X" 

Elselfi >= Asc(" 压 ") And i < Asc(" 臣 ") Then 
拼音 头 字母 = "Y" 

Elselfi >= Asc(" 功 ") And i <= Asc(" 座 ") Then 
拼音 头 字母 = "Z" 

End ff 


' 检 测 i 是 否 落 在 H 首尾 汉字 拼音 字母 间 
' 检 测 i 是否 落 在 J 首尾 汉字 拼音 字母 间 
' 检 测 i 是否 落 在 K 首尾 汉字 拼音 字母 间 
' 检 测 ij 是否 落 在 L 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 M 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 N 首尾 汉字 拼音 字母 间 
"检测 i 是 否 落 在 O 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 P 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 Q 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 R 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 S 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 T 首尾 汉字 拼音 字母 间 
"检测 i 是 否 落 在 W 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 X 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 Y 首尾 汉字 拼音 字母 间 
' 检 测 i 是 否 落 在 Z 首尾 汉字 拼音 字母 间 


End Function 
4.3.7 ”修改 按钮 代码 


【修改 】 按 钮 完成 的 任务 是 : 对 显示 在 当前 窗 体 且 已 经 被 用 户 编辑 好 的 客户 记录 做 保存 
操作 。 单 击 该 按钮 后 ， 首 先 会 询问 用 户 是 否 做 出 修改 动作 。 单 击 【 确 定 】 按 钮 后 ， 程 序 将 会 
把 当前 窗 体 已 编辑 完成 的 客户 记录 所 有 项 目 依 次 写 入 客户 表 中 ， 从 而 实现 修改 保存 工作 。 该 
过 程 代码 并 不 复杂 ， 这 里 不 再 给 出 过 程 的 流程 图 。 以 下 是 该 过 程 的 具体 代码 解释 : 
Private Sub 修改 _Click() 

Dim i As Integer 

"准备 修改 选 定 的 客户 资料 ， 首 先 询问 用 户 是 否 做 出 修改 操作 

lf MsgBox(" 是 否 修 改选 定 的 客户 资料 ?", vbQuestion + vbYesNo, "修改 资料 ") = vbYes Then 

' 将 修改 后 的 客户 记录 所 有 项 目 依次 写 入 客户 表 中 

Fori= 0 To UBound(myArray) "循环 所 有 文本 框 和 复合 框 
Ws.Cells(intRowNow,i+ 1) = Me.Controls(myArray(i)).Value "保存 客户 信息 
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Next 
Ws.Columns.AutoFit ' 客 户 表 所 有 列 自动 适应 ， 调 整 列 宽 
"保存 工作 秒 
ThisWorkbook.Save 
Endif 
End Sub 


4.3.8 删除 按钮 代码 


【删除 】 按 钮 需要 完成 的 工作 比 【 修 改 】 按 钮 要 多 。 因 为 删除 动作 除了 要 完成 删除 数据 、 
保存 外 ， 还 需要 确定 下 一 条 显示 在 窗 体 上 的 当前 客户 记录 。 并 且 在 确定 当前 显示 记录 后 ， 还 
需要 修改 intRowNow 变量 。 该 变量 即 当 前 显示 客户 记录 在 客户 表 中 的 行 号 ， 其 作用 就 是 随时 
保存 当前 客户 记录 在 客户 表 中 的 行 号 ， 以 便 程序 能 够 随时 确认 当前 记录 在 客户 表 中 的 位 置 ， 
而 不 需要 再 次 进行 查询 定位 。 

过 程 首 先 询问 用 户 是 否 做 出 删除 操作 。 用 户 确 认 删 除 操作 后 ， 程 序 根据 intRowNow 变量 
记录 的 行 号 ， 在 客户 表 中 直接 删除 该 行 。 随 后 程序 根据 客户 表 中 剩余 行 数 intRowCount 以 及 
intRowNow 变量 确认 应 该 做 出 何 种 操作 。 

当 intRowCount 为 1 时 , 说 明 客户 表 中 没有 任何 客户 记录 , 此 时 将 重 置 窗口 中 所 有 文本 框 
和 复合 框 。 当 intRowCount 超过 1 且 intRowNow 大 于 intRowCount 时 ， 说 明 intRowCount 行 
即 为 当前 的 显示 行 。 当 intRowCount 超 过 1 上 且 intRowNow 小 于 intRowCount 时 ,说明 intRowNow 
行 即 为 当前 的 显示 行 。 

完成 所 有 客户 资料 信息 显示 后 ， 程 序 需 要 重新 设置 各 个 浏览 按钮 的 状态 ， 以 适应 当前 客 
户 表 中 记录 行情 况 。 随 后 程序 保存 了 删除 客户 记录 后 的 工作 表 。 其 中 设置 按钮 状态 的 过 程 请 
见 本 节 后 续 内 容 。 删 除 按钮 单 击 事件 过 程 的 流程 如 图 4-23 所 示 。 

在 客户 表 中 删除 第 intRowNow 行 


获取 客户 表 数 据 行 数 intRowCount 


重 置 窗口 中 文本 框 和 复合 框 


一 
Se = 


将 客户 表 第 intRowNow 行 数 
据 写 入 窗口 文本 框 和 复合 框 


刷新 窗口 浏览 按钮 状态 


图 4-23 【删除 】 按 钮 单 击 事件 过 程 流程 图 
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以 下 是 该 按钮 的 详细 代码 说 明 。 
Private Sub 删除 _Click() 
Dim i As Integer, intRowCount As Integer 
"准备 删除 选 定 的 客户 资料 
lf MsgBox(" 是 否 删除 选 定 的 客户 资料 ?", vbQuestion + vbYesNo, "删除 资料 ") = vbYes Then 
' 在 客户 表 中 删除 指定 客户 记录 行 
ws.Rows(intRowNow).Delete Shift:=xlUp 
' 获 取 删 除 记录 后 客户 表 中 有 数据 行 的 行 数 
intRowCount = Ws.Range("A" & Rows.Count).End(xIUp).Row 
' 当 总 行 数 只 有 1 行 时 ， 即 只 有 标题 行 时 ， 对 窗 体 做 重 置 操作 ， 并 做 出 提示 
' 当 总 行 数 超 过 1 行 时 ， 检 测 当 前 指向 的 行 号 是 否 超过 最 大 行 
' 当 前 行 号 超过 最 大 行 时 ， 将 当前 行 修改 为 最 大 行 ， 即 显示 最 后 一 条 记录 
' 当 前 行 号 小 于 最 大 行 时 ， 继 续 显示 当前 行 
IfintRowCount = 1 Then 
' 重 置 所 有 文本 框 和 复合 框 控件 
Fori=1 To UBound(myArray) + 1 "循环 所 有 文本 框 和 复合 框 
Me.Controls(myArray(i -1)).Value = " ' 置 空 控件 显示 数据 
Next 
' 将 焦点 移 到 客户 ID 文本 框 
客户 ID.SetFocus "鼠标 焦点 移动 到 客户 ID 文本 框 
' 设 置地 区 文本 框 和 国家 文本 框 的 默认 值 
地 区 .ListiIndex = 0 
国家 .Value = "中 国 " 
MsgBox "客户 记录 表 中 已 没有 任何 客户 资料 ! " vbOKOnly + vblnformation 
Else 
fintRowNow > intRowCount Then ' 检 测 intRowNow 是 否 大 于 intRowCount 
intRowNow = intRowCount "修改 intRowNow 变量 
End If 
' 将 当前 行 的 记录 从 客户 表 中 依次 写 入 窗 体 中 
Fori= 0 To UBound(myArray) "循环 所 有 文本 框 和 复合 杠 
Me.Controls(myArray(i)).Value = Ws.Cells(intRowNow,i+ 1) “显示 客户 数据 到 窗口 
Next 
提示 .Caption = "当前 记录 在 客户 表 中 位 于 第 " & intRowNow & " 行 " 
MsgBox "该 条 记录 已 经 删除 ， 当 前 显示 的 记录 位 于 客户 表 的 第 ” & intRowNow & " 行 \ 
vbOKOnly + vblnformation 
End If 
浏览 按钮 状态 "设置 窗口 中 浏览 按钮 状态 
"保存 工作 短 
ThisWorkbook.Save 
End If 
End Sub 


4.3.9 查看 客户 表 按 钮 代码 


【查看 客户 表 】 按 钮 可 以 显示 和 隐藏 客 户 表 。 通 过 该 按钮 用 户 可 以 查看 所 有 已 经 建立 在 
系统 中 的 所 有 客户 资料 。 当 第 一 次 单 击 该 按钮 时 ， 将 会 显示 客户 表 ， 按 钮 的 Caption 属性 会 被 
修改 为 “隐藏 客户 表 ”。 再 次 单 击 时 ， 将 会 隐藏 客户 表 ， 按 钮 的 Caption 属性 被 修改 为 “查看 
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客户 表 ”。 反 复 操作 ， 依 此 类 推 。 整 个 功能 的 实现 使 用 了 Static 定义 的 一 个 局 部 静态 变量 。 
该 过 程 的 代码 并 不 复杂 ， 以 下 不 再 列 出 该 过 程 的 流程 图 。 其 详细 代码 解释 如 下 : 


Private Sub 查看 客户 表 _Click() 
Static intCountClick As Integer 
intCountClick = intCountClick + 1 ' 累 记 该 按钮 被 单 击 的 次 数 
IfintCountClick Mod 2 Then 
' 单 击 奇数 次 时 ， 执 行 以 下 代码 
查看 工作 表 .Caption = "隐藏 客户 表 " "修改 按钮 Caption 属性 


ws.Visible = xlSheetVisible "修改 客户 表 Visible 属性 为 可 见 
ws.Activate "激活 客户 表 

Else 
ws.Visible = xlSheetVeryHidden 路 改 客户 表 Visible 属性 为 不 可 见 
查看 工作 表 .Caption = "查看 客户 表 " "修改 按钮 Caption 属性 

End If 

End Sub 


4.3.10 浏览 按钮 代码 


在 窗口 中 包含 了 4 个 用 于 浏览 客户 记录 的 按钮 。 这 些 按钮 的 功能 与 代码 都 不 复杂 ， 相 互 
之 间 还 有 一 定 的 相似 性 。 因 而 本 节 将 这 几 个 按钮 的 代码 放置 在 一 起 ， 以 便 读 者 阅读 并 加 以 比 
较 。 以 下 是 各 个 按钮 的 功能 描述 : 
口 【 首 条 】 按 钮 : 单 击 该 按钮 时 ， 窗 口中 显示 的 客户 记录 将 会 跳 转 到 客户 表 的 首 条 客 
户 记录 〈 即 第 二 行 记 录 ) 。 在 该 按钮 的 单 击 事件 过 程 中 ， 还 需要 修改 各 个 浏览 按钮 
〈 首 条 、 上 一 条 、 下 一 条 和 最 后 按钮 ) 的 可 用 状态 以 及 提示 标签 。 而 修改 各 个 浏览 
按钮 的 可 用 状态 是 通过 “浏览 按钮 状态 ”过 程 完 成 的 。 该 过 程 的 具体 代码 介绍 请 见 
节 。 
口 -一 条 】 按 钮 : 单 击 该 按钮 时 ， 将 首先 修改 当前 行 的 行 数 ， 以 将 当前 行 指 向 上 一 
行 ， banned 并 显示 提示 信息 。 
口 【下 一 条 】 按钮 ， 该 按钮 单 击 事件 的 代码 和 上 一 条 按钮 的 代码 类 似 。 唯 一 不 同 之 处 
是 : 它 把 当前 行 的 行 号 加 1， 将 所 指向 的 行 向 后 移动 一 行 
口 【最 后 】 按 钮 ， 该 按钮 单 击 事件 代码 和 首 条 按钮 的 代码 类 似 。 首 先 确 定 所 要 指向 的 
当前 行 的 行 号 ， 然 后 将 当前 行 的 所 有 项 目 显示 到 窗口 中 。 
以 下 是 各 个 按钮 的 详细 代码 解释 : 
Private Sub 首 条 _Click() 


intRowNow =2 ' 修 改 当前 行 号 为 2 

浏览 按钮 状态 ' 修 改 各 浏览 按钮 的 可 用 状态 

' 将 当前 记录 显示 到 窗 体 中 

Fori= 0 To UBound(myArray) "循环 所 有 文本 框 和 复合 杠 
Me.Controls(myArray(i)).Value = ws.Cells(intRowNow,i+ 1) ”指定 控件 显示 值 

Next 

提示 .Caption = "当前 记录 在 客户 表 中 位 于 第 " & intRowNow & " 行 ” “显示 提示 信息 

End Sub 


Private Sub 上 一 条 _Click() 


intRowNow = intRowNow -1 路 改 当前 行 的 行 号 

' 将 当前 行 的 所 有 项 目 显示 到 窗口 中 

Fori= 0 To UBound(myArray) "循环 所 有 文本 框 和 复合 杠 
Me.Controls(myArray(i)).Value = ws.Cells(intRowNow, i+ 1) 指定 控件 显示 值 

Next 

浏览 按钮 状态 ' 修 改 各 个 浏览 按钮 的 可 用 状态 

提示 .Caption = "当前 记录 在 客户 表 中 位 于 第 " & intRowNow & " 行 " “' 显 示 提 示 信 息 

End Sub 

Private Sub 下 一 条 _Click() 

intRowNow =intRowNow + 1 ' 修 改 当 前 行 的 行 号 

"将 当前 行 的 所 有 项 目 显示 到 窗口 中 

Fori= 0 To UBound(myArray) "循环 所 有 文本 框 和 复合 杠 
Me.Controls(myArray(i)).Value = ws.Cells(intRowNow,i+1) ”指定 控件 显示 值 

Next 

浏览 按钮 状态 ' 修 改 各 个 浏览 按钮 的 可 用 状态 

提示 .Caption = "当前 记录 在 客户 表 中 位 于 第 " & intRowNow & " 行 "” "显示 提示 信息 

End Sub 


Private Sub 最 后 _Click() 
Dim intRowCount As Integer 
intRowCount = ws.Range("A" & Rows.Count).End(xIUp).Row 获取 客户 表 中 最 后 客户 记录 行 的 行 号 


intRowNow = intRowCount 将 当前 行 指向 最 后 记录 行 

' 将 当前 行 的 所 有 项 目 显示 到 窗口 中 

Fori= 0 To UBound(myArray) "循环 所 有 文本 框 和 复合 杠 
Me.Controls(myArray(i)).Value = ws.Cells(intRowNow,i+ 1) ”指定 控件 显示 值 

Next 

浏览 按钮 状态 ' 修 改 各 个 浏览 按钮 的 可 用 状态 

提示 .Caption = "当前 记录 在 客户 表 中 位 于 第 " & intRowNow & " 行 "” ”显示 提示 信息 

End Sub 


4.3.11 浏览 按钮 状态 过 程 代码 设计 


浏览 按钮 状态 过 程 用 于 刷新 窗口 中 浏览 按钮 的 可 用 状态 。 该 过 程 根据 窗口 中 显示 客户 记 
录 在 客户 表 中 的 行 号 决定 各 个 浏览 按钮 的 可 用 状态 。 

当 intRowNow -2 值 大 于 0 时 ， 说 明 当前 行 不 在 首 条 ，【 首 条 】 按钮 可 用 ， 和 否则 【 首 条 】 
按钮 不 可 用 。【 上 一 条 】 按 钮 的 可 用 状态 和 【 首 条 】 按 钮 的 可 用 状态 设置 一 样 。 当 intRowCount 
-intRowNow 值 大 于 0 时， 说明 当 前 显示 记录 行 在 客户 表 总 行 数 前 面 。 此 时 【下 一 条 】 按 钮 可 
用 ， 和 否则 【下 一 条 】 按 钮 不 可 用 。【 最 后 】 按 钮 的 可 用 状态 和 【下 一 条 】 按 钮 一 样 。 

以 下 是 该 过 程 的 详细 代码 解释 : 

Sub 浏览 按钮 状态 () 

Dim intRowCount As Integer 

获取 客户 表 中 最 后 客户 记录 行 的 行 号 


intRowCount = ws.Range("A" & Rows.Count).End(xIUp).Row， 
' 当 表达 式 intRowNow -2 值 大 于 0 时 ， 当 前 行 不 在 首 条 ， 首 条 按钮 可 用 
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' 当 表达 式 intRowNow -2 值 小 于 等 于 0 时 ， 当 前 行 在 首 条 ， 首 条 按钮 不 可 用 

首 条 .Enabled = intRowNow -2 

' 上 一 条 按钮 的 可 用 状态 类 似 于 首 条 按钮 

上 一 条 .Enabled = intRowNow -2 

' 当 表达 式 intRowCount -intRowNow 值 大 于 0 时 ， 当 前 行 在 总 行 数 前 面 ， 按 钮 可 用 

' 当 表达 式 intRowCount -intRowNow 值 小 于 等 于 0 时 ， 当 前 行 在 总 行 数 后 面 ， 按 钮 不 可 用 
下 一 条 .Enabled = intRowCount -intRowNow 

最 后 按钮 的 可 用 状态 与 下 一 条 类 似 

最 后 .Enabled = intRowCount -intRowNow 

End Sub 


4.4 客户 资料 查询 导出 窗 体 设计 


客户 资料 查询 导出 模块 完成 客户 资料 的 查询 和 导出 工作 。 查 询 得 到 的 客户 资料 会 立即 显 
示 在 窗口 中 的 客户 清单 上 。 导 出 查询 结果 时 ， 只 需要 单 击 窗 体 上 的 【输出 报表 】 按 钮 即 可 。 
用 户 在 查询 客户 资料 时 ， 可 以 采用 3 种 方式 : 
口 ”通过 在 筛选 列表 框 中 选择 筛选 条 件 查 询 客户 资料 。 窗 口中 包含 了 3 个 列表 框 ， 它 们 
分 别 对 应 建立 客户 资料 时 的 国家 、 地 区 和 城市 3 个 项 目 。 当 需要 将 客户 按照 所 在 区 
域 位 置 划 分 时 ， 这 种 查询 比较 方便 。 
口 “ 按 客户 名 称 查 询 客户 资料 。 用 户 可 以 采用 3 种 客户 名 称 输入 方式 ， 按 全 名 、 按 缩写 
和 按 拼 音 。 选 择 查 询 方式 后 ， 在 【输入 条 件 值 】 文 本 框 中 输入 查询 值 后 单 击 【开始 
查询 】 按 钮 即 可 。 
口 ” 按 其 他 项 目 查询 客户 资料 。 按 其 他 项 目 查 询 需 要 设置 3 项 查询 参数 。 在 【选择 项 目 】 
下 拉 列 表 框 中 输入 项 目 名 ， 这 些 项 目 名 对 应 客户 资料 建立 时 的 所 有 项 目 。 选 择 匹 配 符 
支持 等 于 和 Like (类似) 两 种 匹配 方式 ， 然 后 在 【输入 条 件 值 】 文 本 框 中 输入 查询 值 


即 可 。 
客户 信息 管理 窗 体 的 界面 如 图 4-24 所 示 。 
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图 4-24 客户 资料 查询 导出 窗 体 界面 


办 公 应 用 匡 党 之 狗 


Excel VBA 应 用 开发 经 典 案例 


4.4.1 窗 体 界面 设计 


客户 资料 查询 导出 窗 体 界面 的 控件 按照 其 功能 可 以 划分 为 5 块 ， 它 们 分 别 是 按 区 域 筛选 
列表 框 、 按 客户 名 称 查询 、 按 其 他 项 目 查询 、 功 能 按钮 区 和 查询 结果 清单 。 

1. 按 区 域 筛选 列表 框 
该 区 域 仅 包含 3 个 列表 框 ， 分 别 指向 建立 客户 资料 时 的 3 个 项 目 : 国家 、 地 区 和 城市 。 
在 窗 体 初始 化 时 ，【 选 择 国家 】 列 表 框 会 获取 初始 值 。 在 【选择 国家 】 列 表 框 中 做 出 选择 后 ， 
【选择 地 区 】 列 表 框 会 获取 当前 国家 下 所 有 的 地 区 值 。 在 【选择 地 区 】 列 表 框 中 做 出 选择 后 ， 
【选择 城市 】 列 表 框 会 获取 当前 国际 、 地 区 下 的 城市 值 。 在 以 上 做 出 选择 的 同时 ， 所 有 符合 
当前 区 域 筛选 条 件 的 客户 资料 会 被 立即 显示 在 下 面 的 客户 清单 上 。 

3 个 列表 框 控件 的 ListStyle 属性 在 窗 体 初始 化 时 被 设置 为 fmListStyleOption。 列 表 框 中 各 
个 选项 的 左 方 将 显示 选项 按钮 。 

2， 按 客户 名 称 查询 
该 区 域 包括 3 个 单 选 按钮 、1 个 文本 框 。3 个 单 选 按钮 设置 按 客 户 名 称 查 询 的 查询 方式 。 
在 文本 框 中 输入 对 应 该 查询 方式 下 的 查询 条 件 字符 串 。 

3. 按 其 他 项 目 查询 
该 区 域 包括 2 个 列表 框 、1 个 文本 框 。 两 个 列表 框 共同 确定 查询 的 查询 方式 。【 选择 项 目 】 
下 拉 列 表 框 决定 筛选 的 项 目 对 象 。【 选 择 匹配 符 】 下 拉 列 表 框 决定 筛选 的 运算 方式 。 设 置 
配 符 为 等 于 时 ， 输 入 条 件 需 要 输入 完整 条 件 ， 设 置 为 Like 时 可 以 模糊 查询 。 

4. 查询 结果 清单 

该 区 域 仅 包 括 一 个 ListView 控件 ， 该 控件 在 VBE 的 窗 体 设 计 的 默认 工具 箱 中 不 存在 。 调 
出 该 控件 的 步骤 如 下 : 

(1) 首先 依次 选择 Excel 2007 VBE 中 的 【工具 】|【 引 用】 命令 。 在 随后 显示 的 【引用 】 


对 话 框 中 选择 【Microsoft Windows Common Control 6.0】 选 项 ， 然 后 单 击 【确定 】 按 钮 即 可 ， 
如 图 4-25 所 示 。 
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4 
Mierosoft Activex Data Objects 2.5 Library 


定位 :C:\Program Files\Comnon Files\Systen\ado\nsado25. + 
语言 : 标准 


4-25 引用 对 话 框 


Ah 


第 4 章 SP ORR YO 


(2) 在 工具 箱 的 空白 区 域 右 击 ， 在 弹出 的 快捷 菜单 中 选择 【附加 控件 】 命 令 ， 打开 【 附 
加 控件 】 对 话 框 ， 如 图 4-26 所 示 。 在 【附加 控件 】 对 话 框 中 选择 【Micorsoft ListView Control 
6.0 (SP6)】 项 目 ， 然 后 点 击 【确定 】 按 钮 ， 如 图 4-27 所 示 。 

(3) 工具 箱 中 将 会 多 出 一 个 按钮 , 此 时 工具 箱 的 实际 效果 如 图 4-26 所 示 。 单 击 该 按钮 后 ， 
再 在 窗 体 的 设计 器 中 单 击 鼠 标 左 键 即 可 在 窗 体 中 插入 ListView 控件 。 


由 
[ 位 置 C: MINDORS\ syst ena2 \NSCONCTL OCX 


图 4-27 【附加 控件 】 对 话 框 
4.4.2 ” 窗 体 初始 化 代码 


客户 资料 查询 导出 窗口 的 初始 化 工作 大 体 包括 :初始 化 设 轩 列表 柜 丈 观 模 
公共 变量 、 初 始 化 控件 初始 状态 。 需 要 初始 化 的 公共 变量 包 
括 客户 表 工 作 表 对 象 和 客户 资料 项 目 数组 myArray。 需 要 初 
始 化 的 控件 比较 多 ， 下 面 分 类 讲解 。 

按 区 域 查询 中 的 3 个 列表 框 需要 初始 化 显示 模式 和 提示 | 
文本 。ListView 控件 需要 初始 化 标题 、 显 示 类 型 、 整 行 选择 、 | 
网 格 线 及 排序 属性 。【 按 其 他 项 目 查 询 】 选 项 组 中 的 列表 框 
需要 初始 化 项 目 值 与 初始 值 , 其 文本 框 需要 初始 化 提示 文本 。 
该 过 程 中 没有 复杂 的 结构 控制 语句 ， 程 序 的 执行 顺序 没有 中 。 图 4.28 窗口 初始 化 流程 图 
途 发 生 任何 跳 转 。 其 流程 如 图 4-28 所 示 。 

以 下 是 该 初始 化 过 程 的 详细 代码 解释 ; 

Private Sub UserForm _lInitialize() 


Dim SQL As String, i As Integer 
' 设 置 按 区域 查 询 中 的 3 个 列表 框 ListStyle 属性 


ListBox1.ListStyle = fmListStyleOption ' 国 家 列表 框 外 观 模式 
ListBox2.ListStyle = fmListStyleOption ' 地 区 列表 框 外 观 模式 
ListBox3.ListStyle = fmListStyleOption "城市 列表 框 外 观 模式 


' 设 置 按 区 域 查询 中 的 3 个 列表 框 的 提示 文本 

ListBox1.ControlTipText = " 单 击 或 双击 某 个 国家 名 称 ， 显 示 该 国家 的 全 部 客户 信息 " 
ListBox2.ControlTipText = " 单 击 某 个 地 区 名 称 ， 显 示 该 地 区 的 全 部 客户 信息 " 
ListBox3.ControlTipText = " 单 击 某 个 城市 名 称 ， 显 示 该 城市 的 全 部 客户 信息 " 

' 初 始 化 工作 表 对 象 和 客户 资料 项 目 数 组 myArray 

Set ws = Worksheets(" 客 户 表 ") ' 设 定 工作 表 对 象 


办 公 应 用 莫 漳 之 秒 
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myArray = Array(" 客 户 1D", "客户 名 称 ", "名 称 缩写 ", "负责 人 ", "地 址 "，_ 
"邮政 编码 ", "城市 ", "地 区 ", "国家 ", "电话 ", "传真 ", "Email", "网 址 ，_ 
"经 营 范 围 ", "客户 级 别 ", "信用 等 级 ", "联系 人 ", "联系 人 电话 ",，_ 
"联系 人 Email", "备注 ") 

"设置 ListView1 控件 的 标题 、 显 示 类 型 、 整 行 选择 、 网 格 线 及 排序 属性 

With ListView1 


.ColumnHeaders.Clear "清除 标题 
.Listltems.Clear "清除 ListView1 控件 的 项 目 
.View = IvwReport "设置 显示 类 型 
.FullRowSelect = True 整 行 选择 
.Gridlines = True "显示 网 格 线 
.Sorted = True "对 ListView1 中 的 项 目 排序 
' 初 始 化 ListView1 的 标题 
Fori= 0 To UBound(myArray) "循环 myArray 数组 中 所 有 元 素 
.ColumnHeaders.Add ,, myArray(i) 为 复合 框 添加 标题 

Next 

End With 

"建立 与 工作 簿 的 连接 

Set cnn = New ADODB.Connection "新 建 数据 库 链接 


cnn.Open "Provider=microsoftjet.oledb.4.0;”_ 
& "Extended Properties=Excel 8.0;”_ 


& "Data Source=" & ThisWorkbook.FullName ' 指 定数 据 库 链接 字符 串 
' 查 询 所 有 国家 名 称 ， 并 设置 给 列表 框 ListBox1 
myCountry "调用 myCountry 过 程 
' 将 “ 按 客 户 名 称 查询 ”和 “ 按 全 名 ”选项 按钮 设置 为 默认 按钮 
按 全 名 .Value = True "选中 按 全 名 单 选 按钮 
按 客户 名 称 查询 .Value = True "选中 按 客 户 名 称 查询 单 选 按钮 
"查询 各 个 项 目的 不 重复 值 ， 并 设置 给 “查询 项 目 ” 复 合 框 
SQL = "select * from [客户 表 $]" "设置 查询 字符 串 
Set rs = New ADODB.Recordset "获得 新 的 查询 记录 集 对 象 


rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 生成 查询 记录 集 

"设置 在 按 其 他 条 件 插 叙 中 的 文本 框 控件 的 提示 文本 

条 件 值 .ControlTipText = "如 果 不 输入 任何 条 件 值 ， 并 且 匹 配 符 选择 LIKE， 那 么 就 查询 全 部 记录 。" 
' 初 始 化 按 其 他 项 目 查询 中 查询 选择 项 目 复合 杠 


With 查询 项 目 
.Clear "清空 查询 项 目 中 所 有 项 目 
Fori = 0 To rs.Fields.Count -1 "循环 记录 集中 所 有 记录 
.Addltem rs.Fields(i).Name 为 查询 项 目 添 加 项 目 
Next 
.ListIndex = 0 "设置 该 复合 框 的 初始 显示 值 
End With 
' 为 “匹配 符 ” 复 合 框 设置 项 目 
With 匹配 符 
.Clear "清空 匹配 符 复合 框 所 有 项 目 
.Addltem "=" 为 匹配 符 复合 框 添加 第 一 个 项 目 
.Addltem "like" 为 匹配 符 复合 框 添加 第 二 个 项 目 
-ListlIndex = 0 "设置 匹配 符 复合 框 默认 显示 值 
End With 


' 查 询 所 有 国家 的 客户 信息 ， 并 将 有 挂 信息 显示 在 窗 体 上 
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myCountry ' 重 新 显示 客户 信息 
End Sub 


4.4.3 myCountry 与 myList 过 程 代码 设计 


在 窗 体 初始 化 过 程 代码 中 调用 了 一 个 自 定义 公共 过 程 myCountry。 该 公共 过 程 首先 获取 客 
户 表 国家 字段 中 不 重复 项 的 一 个 记录 集 对 象 ， 然 后 调用 myList 公共 过 程 。myList 公共 过 程 将 
不 重复 的 国家 字段 记录 集中 的 记录 写 入 到 当前 复合 框 控 件 中 。myList 过 程 接受 myStr 和 
myListBox 两 个 参数 。 

以 下 是 myCountry 和 myList 公共 过 程 的 详细 代码 解释 : 

Public Sub myCountry() 


Dim SQL As String 

SQL = "select distinct 国家 from [客户 表 $]" ' 指 定 查询 记录 字符 串 

Set rs = New ADODB.Recordset "建立 新 数据 库 记录 集 对 象 

rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 打开 数据 库 查询 记录 集 

myList(" 国 家 " Me.ListBox1) ' 将 查询 获取 的 所 有 不 重复 国家 写 入 国家 列表 框 中 
End Sub 


Public Sub myList(myStr As String, myListBox As MSForms.ListBox) 
Dim i As Integer 

On Error Resume Next 

With myListBox 


.Clear ' 清 空 列表 框 中 所 有 项 目 
Fori= 1 To rs.RecordCount "循环 记录 集中 所 有 记录 
.Addltem rs.Fields(0).Value 为 列表 框 添加 新 项 目 
rs.MoveNext "移动 记录 集 指针 到 下 一 条 记录 
Next 
End With 
End Sub 


4.4.4 按 区 域 筛选 客户 代码 设计 


在 窗口 的 左上 方 包含 了 3 个 列表 框 ， 用 户 可 以 通过 这 3 个 列表 框 对 客户 记录 按 区 域 进行 
查询 。 这 3 个 列表 框 分 别 用 于 选择 国家 、 地 区 、 城 市 ， 选 择 的 顺序 是 从 左 到 右 。3 个 列表 框 的 
事件 代码 主要 是 列表 的 单 击 事件 。 以 下 分 别 介绍 这 3 个 列表 框 的 单 击 事件 的 功能 : 

口 国家 列表 框 单 击 事件 ， 当 用 户 在 【选择 国家 】 列 表 框 中 选择 了 某 个 国家 时 ， 在 【 选 
择 地 区 】 列 表 框 中 将 刷新 出 当前 国家 中 所 有 地 区 ， 同 时 下 方 的 客户 清单 控件 将 会 显 
示 当 前 选择 国家 的 所 有 记录 。 
口 ”地 区 列表 框 单 击 事件 : 当 用 户 在 【选择 地 区 】 列 表 框 中 选择 了 某 个 地 区 时 ， 在 【 选 

择 城市 】 列 表 框 中 将 刷新 出 当前 国家 地 区 下 所 有 城市 ， 同 时 下 方 的 客户 清单 控件 将 

会 显示 当前 选择 国家 与 地 区 的 所 有 记录 。 
口 “城市 列表 框 单 击 事件 ， 当 用 户 在 【选择 城市 】 列 表 框 中 选择 某 个 城市 时 ， 此 时 不 需 


a1 


办 公 应 用 齐 党 乞 比 - 


人 Excel VBA 应 用 开发 经 典 案 例 了 汪汪 


要 再 改变 其 他 列表 框 的 数据 ， 只 需要 将 下 方 的 客户 清单 控件 中 显示 记录 刷新 为 当前 
国家 、 地 区 和 城市 的 记录 即 可 。 

以 下 是 这 3 个 列表 框 的 详细 事件 代码 解释 : 

Private Sub ListBox1_Click() 


Dim SQL As String 

' 重 和 置 选项 按钮 、 文 本 框 的 值 

按 全 名 .Value = True ' 重 置 按 全 名 选项 按钮 的 值 
客户 名 .Value = "" ' 置 空 客户 名 文本 框 

条 件 值 .Value = "" ' 置 空 条件 值 文本 框 


为 地 区 列表 框 设置 项 目 
SQL = "select distinct 地 区 from [客户 表 $] where 国家 =" & ListBox1.Value & "" ”' 设 置 查 询 字符 串 


Set rs = New ADODB.Recordset "新 建 数据 库 记 录 集 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic "打开 数据 库 查 询 记录 集 
myList "地 区 ", Me.ListBox2 "显示 地 区 列表 框 中 的 项 目 


"清除 城市 列表 框 的 项 目 
Me.ListBox3.Clear 


上 查询 指定 国家 的 所 有 客户 信息 

SQL = "select * from [客户 表 $] where 国家 =" & ListBox1.Value & "" "设置 查询 字符 串 
Set rs = New ADODB.Recordset "新 建 数据 库 记录 集 

rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic "打开 数据 库 查询 记录 集 

' 调 用 子 程序 ， 为 ListView1 控件 输入 数据 

myListView ' 将 查询 结果 显示 在 客户 清单 控件 中 
End Sub 

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 

ListBox1_Click ' 国 家 列表 框 双 击 时 执行 单 击 事件 过 程 
End Sub 


Private Sub ListBox2_ Click() 
Dim SQL As String 
' 重 置 选项 按钮 、 文 本 框 的 值 
按 全 名 .Value = True 
客户 名 .Value = " 
条 件 值 .Value = "" 
为 城市 列表 框 设置 项 目 
SQL = "select distinct 城市 from [客户 表 $]" _ 
& " where 国家 =" & ListBox1.Value&"" 


&"and 地 区 =" & ListBox2.Value & "" "设置 查询 字符 串 
Set rs = New ADODB.Recordset "新 建 数据 库 记录 集 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic "打开 数据 库 查 询 记录 集 
myList "城市 ", Me.ListBox3 "显示 地 区 列表 框 中 的 项 目 


上 查询 指定 国家 和 地 区 的 所 有 客户 信息 
SQL = "select * from [客户 表 $] "_ 
&" where 国家 =" & ListBox1.Value&"”_ 


&"and 地 区 =" & ListBox2.Value & "" "设置 查询 字符 串 
Set rs = New ADODB.Recordset "新 建 数据 库 记录 集 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic "打开 数据 库 查 询 记 录 集 


"调用 子 程序 ， 为 ListView1 控件 输入 数据 
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myListView "将 查询 结果 显示 在 客户 清单 控件 中 
End Sub 


Private Sub ListBox3_Click() 

Dim SQL As String 

' 重 置 选项 按钮 、 文 本 框 的 值 

按 全 名 .Value = True 

客户 名 .Value = " 

条 件 值 .Value ="" 

' 查 询 指定 国家 、 地 区 和 城市 的 所 有 客户 信息 

SQL = "select * from [客户 表 $]" _ 
&" where 国家 =" & ListBox1.Value &"™_ 
&"and 地 区 =" & ListBox2.Value &"™ _ 


&" and 城市 =" & ListBox3.Value & "" "设置 查询 字符 串 
Set rs = New ADODB.Recordset "新 建 数据 库 记 录 集 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic ' 打 开 数 据 库 查 询 记 录 集 
"调用 子 程序 ， 为 ListView1 控件 输入 数据 
myListView ' 将 查询 结果 显示 在 客户 清单 控件 中 
End Sub 


4.4.5 ”myListView 过 程 代码 设计 


在 前 面 的 按 区 域 筛选 客户 中 ，3 个 列表 框 的 单 击 事件 代码 最 后 都 调用 了 一 个 过 程 
myListView。 该 过 程 用 于 将 查询 结 ee 单 控件 中 。 该 过 程 的 代码 比较 多 ， 因 而 单 
独 列 了 一 小 节 。 

旦 序 根据 用 户 是 否 选 中 【 按 拼音 查询 】 单 选 按 钮 ， 分 别 执行 分 支 代 码 。 该 分 支 主 要 是 由 
于 按 拼音 查询 时 ， 需 要 检测 记录 中 客户 名 称 的 拼音 是 否 与 输入 的 拼音 一 致 造成 的 。 执 行 完 以 
上 操作 以 后 ， 程 序 为 客户 清单 控件 的 各 个 列 设置 宽度 。 

以 下 是 该 过 程 的 详细 代码 解释 : 

Public Sub myListView() 


On ErrorResume Next 
Dim i As Integer, j As Long 


' 将 查询 结果 显示 在 ListView1 控件 中 
lf 按 拼音 .Value = False Then 
With ListView1 
.Listltems.Clear "清除 控件 所 有 项 目 
Fori = 1To rs.RecordCount "循环 记录 集 所 有 记录 
.Listltems.Add , , rs.Fields(0).Value 为 控件 添加 新 项 目 
Forj = 1To rs.Fields.Count -1 ' 循 环 记 录 所 有 字段 
If IlsNull(rs.Fields(j).Value) Then 检测 记录 字段 是 否 为 空 
Listltems(i).Subltems() ="™" 为 空 时 ， 子 项 显示 空 字符 串 
Else 
.Listltems(i).Subltems(j) = rs.Fields(i).Value “' 设 定子 项 的 数据 
End If 
Next 
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rs.MoveNext ' 将 记录 集 指针 移动 到 下 一 条 记录 
Next 
End With 
rs.MoveFirst ' 将 记录 集 指针 移动 到 首 条 记录 
Else 
With ListView1 
.Listltems.Clear "清除 控件 所 有 项 目 
Fori = 1To rs.RecordCount "循环 记录 集 所 有 记录 
检测 当前 记录 的 客户 名 拼音 是 否 与 输入 拼音 一 致 
lf 检查 拼音 (rs.Fields(" 客 户 名 称 "), intRow) Then 
.Listltems.Add , , rs.Fields(0).Value 为 控件 添加 新 项 目 
Forj = 1To rs.Fields.Count -1 "循环 记录 所 有 字段 
lf IsNull(rs.Fields(j).Value) Then ““' 检 测 记录 字段 是 否 为 空 
.Listltems(i).Subltems(j) = "” 为 空 时 ， 子 项 显示 为 空 字符 串 
Else 
.Listltems(i).Subltems(j) = rs.Fields(j).Value ““' 设 定子 项 的 数据 
End If 
Next 
End If 
rs.MoveNext ' 将 记录 集 指针 移动 到 下 一 条 记录 
Next 
End With 
rs.MoveFirst ' 将 记录 集 指针 移动 到 首 条 记录 
End If 
"自动 设置 ListView1 控件 各 列 的 宽度 
Fori= 1 To ListView1.ColumnHeaders.Count "循环 控件 所 有 标题 列 
ListView1.ColumnHeaders(i).Width = ws.Cells(1, i).Width * 0.9 "设置 标题 列 的 宽度 
Next 
End Sub 


4.4.6 ”选项 按钮 、 文 本 框 和 复合 框 代码 设计 


本 小 节 包 含 讲述 的 控件 比较 多 ， 但 是 各 个 控件 的 代码 都 十 分 简单 。 这 些 控 件 的 事件 代码 
基本 上 都 是 用 于 设置 控件 的 某 个 属性 而 用 的 ， 其 中 部 分 事件 代码 调用 了 ListPriValue 过 程 。 该 
过 程 用 于 设置 3 个 按 区 域 筛选 客户 的 列表 框 以 及 客户 清单 控件 的 显示 项 目 。 以 下 是 这 些 控件 


的 事件 代码 的 详细 解释 : 
Private Sub 按 客户 名 称 查询 _Click() 
查询 项 目 .Value ="" ' 置 空 查询 项 目 复合 框 
匹配 符 .Value ="" ' 置 空 匹配 符 复合 杠 
条 件 值 .Value ="" ' 置 空 条件 值 文本 框 
ListPriValue ' 设 置 3 个 列表 框 控件 和 客户 清单 控件 
End Sub 


Private Sub 按 其 他 项 目 查 询 _Click() 
按 全 名 .Value = False "取消 按 全 名 单 选 按钮 选中 状态 
按 缩写 .Value = False "取消 按 缩写 单 选 按钮 选中 状态 


按 拼音 .Value = False 
客户 名 .Value ="" 
End Sub 


Private Sub 按 全 名 _Enter() 
按 客户 名 称 查询 .Value = True 
ListPriValue 
End Sub 


Private Sub 按 缩写 _Enter() 
按 客户 名 称 查询 .Value = True 
ListPriValue 
End Sub 


Private Sub 按 拼音 _Enter() 
按 客户 名 称 查询 .Value = True 
ListPriValue 
End Sub 


Private Sub 客户 名 _Enter() 
按 客户 名 称 查 询 .Value = True 
ListPriValue 
End Sub 


Private Sub 查询 项 目 _Enter() 
按 其 他 项 目 查询 .Value = True 
ListPriValue 
End Sub 


Private Sub 匹配 符 _Enter() 
按 其 他 项 目 查询 .Value = True 
ListPriValue 
End Sub 


Private Sub 条 件 值 _Enter() 
按 其 他 项 目 查询 .Value = True 
ListPriValue 
End Sub 


Public Sub ListPriValue() 
ListBox1.Listlndex = -1 
ListBox2.Listlndex = -1 
ListBox3.Listlndex = -1 
ListBox2.Clear 
ListBox3.Clear 
ListView1.Listttems.Clear 

End Sub 


"取消 按 拼音 单 选 按钮 选中 状态 
置 空 客户 名 文本 框 


选中 按 客户 名 称 查 询 单 选 按钮 
设置 3 个 列表 框 控 件 和 客户 清单 控件 


选中 按 客户 名 称 查询 单 选 按钮 
"设置 3 个 列表 框 控 件 和 客户 清单 控件 


选中 按 客户 名 称 查询 单 选 按钮 
' 设 置 3 个 列表 框 控件 和 客户 清单 控件 


选中 按 客户 名 称 查 询 单 选 按钮 
设置 3 个 列表 框 控件 和 客户 清单 控件 


选中 按 其 他 项 目 查询 单 选 按钮 
设置 3 个 列表 框 控件 和 客户 清单 控件 


选中 按 其 他 项 目 查询 单 选 按钮 
设置 3 个 列表 框 控件 和 客户 清单 控件 


' 选 中 按 其 他 项 目 查询 单 选 按钮 
设置 3 个 列表 框 控件 和 客户 清单 控件 


' 不 选中 国家 列表 框 中 的 任何 项 目 
' 不 选中 地 区 列表 框 中 的 任何 项 目 
' 不 选中 城市 列表 框 中 的 任何 项 目 
' 清 空地 区 列表 框 所 有 项 目 

' 清 空城 市 列表 框 所 有 项 目 

' 清 空 客户 清单 控件 所 有 项 目 
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4.4.7 ”开始 查询 按钮 单 击 事件 代码 设计 


【开始 查询 】 按 钮 使 用 当前 用 户 输入 的 查询 条 件 完 成 查询 工作 ， 然 后 将 查询 结果 显示 在 


窗口 的 客户 清单 控件 中 。 


单 击 【 开 始 查 询 】 按 钮 后 ， 程 序 将 根据 用 户 的 查询 设置 条 件 ， 定 义 数据 库 查询 字符 


日 


Po 


从 窗口 中 可 以 看 出 按 客 户 名 称 查询 和 按 其 他 项 目 查 询 的 查询 字符 串 显然 是 不 同 的 。 而 这 两 个 


情况 下 还 有 其 他 各 项 设置 ， 当 选择 不 同 设置 时 ， 查 询 字符 串 也 不 一 样 。 


获取 了 相应 的 查询 字符 串 之 后 ， 程 序 将 打开 该 查询 记录 集 。 该 记录 集中 没有 客户 名 称 拼 
音字 头 字 段 ， 因 此 当 用 户 选择 了 按 拼音 查询 时 ， 需 要 检测 客户 名 称 拼 音字 头 是 否 与 用 户 输入 
一 致 。 这 里 程序 通过 一 个 If 结构 分 情况 处 理 。 最 后 ， 程 序 将 查询 到 的 符合 条 件 的 记录 显示 在 


客户 清单 控件 中 。 
该 按钮 的 单 击 事件 代码 解释 如 下 : 
Private Sub 开始 查询 _Click() 


Dim SQL As String 
SQL = "select * from [客户 表 $]" "设置 查询 字符 串 
lf 按 客户 名 称 查询 .Value = True Then ' 检 测 按 客户 名 称 查询 单 选 按钮 是 否 选中 
lf 按 全 名 .Value = True Then ' 检 测 按 全 名 单 选 按钮 是 否 选中 
SQL = SQL & "where 客户 名 称 =" & 客户 名 .Value & ""  ' 设 置 按 全 名 时 的 查询 字符 串 
Elself 按 缩写 .Value = True Then ' 检 测 按 缩写 单 选 按钮 是 否 选中 
SQL = SQL & " where 名 称 缩写 =" & 客户 名 .Value & "" ”' 设 置 按 缩写 时 的 查询 字符 串 
Elself 按 拼音 .Value = True Then ' 检 测 按 拼音 单 选 按钮 是 否 选中 
SQL = SQL "设置 按 拼音 时 的 查询 字符 串 
End If 
Elself 按 其 他 项 目 查询 .Value = True Then "检测 按 其 他 项 目 查询 单 选 按钮 是 否 选中 
lf 匹配 符 .Value = "=" Then ' 检 测 匹 配 符 是 否 选择 等 于 号 
"设置 匹配 符 为 等 于 号 时 的 查询 字符 串 
SQL = SQL & " where " & 查询 项 目 .Value & "=" & 条 件 值 .Value & "" 
Else 
' 设 置 匹配 符 为 Like 时 的 查询 字符 串 
SQL =SQL& " where " & 查询 项 目 .Value & " like '%" & 条 件 值 .Value & "%" 
End If 
End ff 
Set rs = New ADODB.Recordset "新 建 数据 库 记录 集 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic "从 数据 库 中 获取 记录 集 
lf 按 拼音 .Value = False Then "检测 按 拼音 单 选 按钮 是 否 选中 
Ifrs.EOF And rs.BOF Then ' 检 测 记 录 集 是 否 为 空 
MsgBox "没有 查询 到 符合 条 件 的 记录 ! ", vblnformation, "查询 结果 " 
Else 
myListView ' 刷 新 客户 清单 控件 项 目 
End If 
Else 
lf 检查 拼音 (客户 名 .Value) = True Then ' 检 测 客户 名 称 拼 音字 头 
myListView ' 刷 新 客户 清单 控件 项 目 
End If 
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End If 
End Sub 


4.4.8 输出 报表 过 程 代码 设计 


输出 报表 过 程 用 于 将 当前 查询 到 的 结果 保存 在 一 个 新 Excel 文件 中 。 该 程序 首先 新 建 了 一 
个 工作 短 ， 然 后 循环 记录 集 的 字段 ， 将 字段 名 作为 新 工作 表 的 标题 行 ， 接 着 从 该 记录 集 直 接 
将 数据 复制 到 新 工作 表 中 ， 最 后 将 工作 表 的 所 有 列 自 动 对 齐 。 该 过 程 的 代码 比较 简单 ， 流 程 
并 不 复杂 ， 以 下 不 再 列 出 该 过 程 的 流程 图 。 


以 下 是 该 过 程 的 代码 解释 : 
Private Sub 输出 报表 _Click() 
Dim i As Integer 
Dim wb As Workbook 
Set wb = Workbooks.Add "新 建 工 作 简 
With wb.ActiveSheet 
Fori = 1To rs.Fields.Count "循环 记录 集 所 有 字段 
.Cells(1, ) = rs.Fields(i -1).Name ' 将 字段 名 写 入 工作 表 的 标题 
Next 
.Range("A2").CopyFromRecordset rs ' 从 记录 集中 直接 复制 数据 到 A2 单元 格 
.Columns.AutoFit ' 工 作 表 自动 对 齐 
End With 
End Sub 


4.5 系统 测试 


本 系统 中 所 有 功能 都 是 通过 首页 的 两 个 按钮 实现 的 ， 这 两 个 按钮 分 别 打开 相应 的 窗口 ， 
用 户 在 这 两 个 窗口 中 分 别 完 成 相应 的 工作 。 下 面 以 具体 的 操作 流程 来 演示 系统 的 操作 方式 。 
基于 系统 的 两 个 窗口 ， 以 下 将 分 两 个 小 节 分 别 介绍 两 窗口 的 操作 。 


4.5.1 客户 资料 管理 窗口 测试 


该 窗口 中 需要 测试 的 是 几 个 按钮 的 功能 是 否 准确 实现 。 其 中 新 增 、 修 改 、 删 除 以 及 逐条 
浏览 按钮 的 代码 十 分 简单 。 此 处 不 再 加 以 具体 测试 ， 用 户 可 以 自己 打开 工作 短 后 ， 测 试 这 些 
按钮 的 功能 。 本 小 节 讲 述 的 主要 是 【查找 】 和 【查看 客户 表 】 按 钮 的 功能 。 查 找 按钮 的 代码 
稍 显 复 杂 ， 而 查看 客户 表 按钮 将 激活 客户 表 。 以 下 是 这 两 个 按钮 的 测试 过 程 。 

(1) 在 工作 敌 的 首页 单 击 【 客 户 资料 管理 】 标 签 按钮 ， 打 开 【 客 户 资料 管理 】 窗 口 (如 
图 4-29 所 示 ) ， 其 中 被 画 圈 的 按钮 为 需要 测试 的 两 个 按钮 。 窗 口 当前 显示 的 记录 为 客户 表 中 
第 一 条 客户 记录 ， 因 而 此 时 【 首 条 】 与 【上 一 条 】 按 钮 都 为 不 可 用 。 


EEEEEE3 [yl 
三 客户 信息 资料 
Pm ol 全 Ja 新 增 
客户 名 称 | 北京 凤凰 咨询 公司 a [Ex ( 查找 )| 
名 称 编写 | BTEK 网 二 EX 修改 
负责 人 [jom E 出 除 
Ee Pagal [mw 一 
机 站 信用 [wm (ans) 
城市 北京 A Es 
过 = - Cm 上 -条 
国家 中 国 RE wh 1s cm | 下 -条 
电话 Ea 备注 最 后 
当前 记录 在 客户 表 中 位 于 第 2 行 退出 


图 4-29 客户 资源 管理 窗口 测试 


(2) 单 击 【查找 】 按 钮 ， 将 打开 一 输入 框 〈 如 图 4-30 所 示 ) ， 这 里 输入 “shdfgs”， 单 
击 【 确 定 】 按 钮 。 


图 4-30 ”客户 名 称 拼音 字 头 输入 框 
(3) 程序 将 在 客户 表 中 查找 客户 名 称 拼音 字 头 为 “shdfgs” 的 记录 ， 在 客户 表 中 存在 一 
条 “上 海 东 方 公司 ”的 记录 与 之 对 应 。 此 时 ， 窗 口 将 定位 到 该 记录 并 将 其 显示 到 窗口 中 ， 查 
找 结果 如 图 4-31 所 示 。 从 图 中 提示 中 可 以 知道 该 记录 位 于 客户 表 的 第 四 行 。 此 时 ，【 首 条 】 


和 【上 一 条 】 按 钮 的 可 用 状态 都 被 恢复 。 客 户 表 一 共 5 行 ， 所 以 【下 一 条 】 和 【最 后 】 按 钮 
都 可 用 。 
EE] 
一 才 户 信息 资料 
Pm | 人 Tasssssss 新 增 
EE FE Ta 修改 
全 责 人 [FFFppp ee i 
上 海 市 客 P 人 别 [A 
[ET 人 NS | ie 
es mA [十 本 | 
地 区 ET 一 联系 人 电话 [ssoassss 上 一 条 
国家 中 国 联系 人 Esail| wh 163. com 下 一 条 
电话 88888888 备注 | | 景 后 


4-31 查找 结果 显示 


_ 


第 4 章 客户 知 要 系统 We 


(4) 在 窗口 中 单 击 【 查 看 客户 表 )】 按钮 ， 此 时 客户 表 将 会 被 显示 出 来 (如 图 4-32 所 示 ) 。 
用 户 可 以 在 表 中 查看 所 有 已 经 建立 资料 的 客户 记录 。 


ra -ox 
4 I 和 D E EN Hl I J K | L 加 
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本 ADOO3 CE SHDF PPPppp ”上海 市 210000 ”上 海 市 。 华东 中 国 "B8888888 "38888888 38888@yahoo. 
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图 4-32 查看 客户 表 所 有 记录 


4.5.2 ”客户 资料 查询 导出 窗口 测试 


在 【客户 资料 查询 导出 】 窗 口中 ， 一 共 包含 了 3 个 查询 方式 ， 分 别 是 按 区 域 查询 、 按 客 
户 名 称 查询 和 按 其 他 项 目 查 询 。 这 里 只 介绍 按 区 域 查 询 操作 过 程 。 其 测试 操作 过 程 如 下 : 

(1) 在 首页 单 击 【 客 户 资料 查询 导出 】 标 签 , 打开 【客户 资料 查询 导出 】 窗 口 (如 图 4-33 
所 示 ) ， 图 中 已 经 在 【选择 国家 】 列 表 框 中 选中 了 【选择 中 国 】 单 选 按钮 ， 此 时 可 以 看 到 客 
户 清单 中 已 经 将 所 有 国家 字段 为 “中 国 ” 的 记录 显示 出 来 ， 而 【选择 地 区 】 列 表 框 中 也 显示 
了 所 有 地 区 项 目 。 


可 BJFK ”000 北京 市 
治本 HB 河北 省 石 . 1 五 家 Ea 昌国 
十 海 东 方 公司 PPppp ”上海 市 210000 华东 中 国 
新 江北 方 公司 ZB 浙江 省 杭 . 310000 ”杭州 市 ”华东 中 国 


图 4-33 客户 资料 查询 导出 测试 
(2) 在 【选择 地 区 】 列 表 框 中 选中 【华东 】 单 选 按钮 ， 此 时 查询 的 记录 是 所 有 国家 为 “中 
国 ”、 地 区 为 “华东 ”的 记录 ， 其 查询 结果 如 图 4-34 所 示 。 从 图 中 可 以 看 出 客户 清单 已 经 显 
示 了 所 有 查询 结果 ， 并 且 【 选 择 城市 】 列 表 框 中 也 显示 了 所 有 的 城市 。 
(3) 在 【选择 城市 】 列 表 框 中 选择 【杭州 市 】， 此 时 查询 记录 就 是 所 有 国家 为 “中 国 ”、 
区 为 “华东 ”、 城 市 为 “杭州 市 ”的 记录 ， 查 询 结 果 如 图 4-35 所 示 。 
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图 4-34 选择 国家 与 地 区 查询 结果 
可 


一 选择 国家 这 所 地 区 违反 城市 
[EEN | 加 
oi -ORL 


EE | sll ls | wl ls | 
清音 


图 4-35 选择 国家 、 地 区 和 城市 查询 结果 


第 5 章 学 生成 绩 管理 系统 


学 生成 绩 管理 是 学 校 教 学 管理 的 一 个 重要 组 成 部 分 。 根 据 学 校 的 具体 需求 ， 建 立 一 套 完 
善 的 学 生成 绩 管理 系统 ， 实 现成 绩 管理 的 数字 化 、 信 息 化 ， 可 以 大 幅度 减轻 教务 工作 人 员 的 
工作 强度 ， 提 高 工作 效率 。 

本 实例 主要 针对 中 小 型 学 校 的 成 绩 管 理工 作 设 计 , 借助 了 Excel 的 常用 功能 及 其 便利 的 输 
入 环境 ， 提 高 了 实例 的 可 操作 性 和 实用 性 。 


5.1 系统 概述 


本 例 大 量 使 用 了 Excel 2007 本 身 自 带 的 功能 ， 如 数据 有 效 性 、 自 动 筛选 、 冻 结 窗口 等 。 
实例 以 工作 表 来 表现 操作 界面 ， 包 含 的 代码 简单 易 懂 ， 整 体 架 构 清 晰 ， 可 以 轻松 辅助 使 用 者 
完成 学 生成 绩 建立 、 查 询 与 编辑 工作 。 

5.1.1 设计 思 


本 实例 基于 学 校 成 绩 管理 的 需求 ， 需 要 完成 输入 、 分 析 和 查询 功能 。 将 系统 整体 架构 划 
分 为 3 大 功能 模块 ， 即 基本 资料 建立 模块 、 成 绩 输入 与 分 析 模 块 和 查询 模块 。 系 统 详细 结构 


如 图 5-1 所 示 。 
学 生成 绩 管理 系统 
基本 资料 建立 模块 成 绩 输入 与 分 析 模块 | 查询 模块 
I | 


攻 三 二 疏 上 烽 门 

刁 丰 亲 个 淋 汪 

半路 泪 滞 党 上 由 六 
> 过 举 汉 
的 导 沾 地 
脱 序 忆 疗 怒 “ 王 
起 内 盱 站 河津 门 
bs 3 

枯 史 光泽 片 料 三 


图 5-1 系统 详细 结构 图 


以 下 为 各 个 模块 的 详细 功能 介绍 。 
口 基本 资料 建立 模块 ,该 模块 完成 系统 基本 资料 的 建立 。 包 括 学 生 名 单 建立 、 教 师资 


办 公 应 用 汪 党 之 多 


Excel VBA 应 用 开发 经 典 案例 
料 建立 与 年 级 班级 资料 建立 3 个 子 功 能 块 。 


口 ”成绩 输入 与 分 析 模 块 ， 该 模块 完成 学 生成 绩 资料 的 输入 与 分 析 工 作 ， 包 括 成 绩 输入 、 
年 级 排名 与 成 绩 再 处 理 3 个 子 功能 
口 


查询 模块 该 模块 完成 学 生 、 老 师资 料 与 成 绩 查 询 工作 ， 包 括 班级 学 生 查 询 、 教 师 
查询 与 学 生成 绩 查询 3 个 子 功能 块 。 

本 例 大 量 使 用 了 Excel 自 带 的 功能 ， 例 如 排序 、 自 动 筛选 、 数 据 有 效 性 。 排 序 功能 主要 使 
用 在 对 学 生成 绩 表 的 名 次 计算 中 ， 首 先 对 总 分 按照 降序 排列 ， 然 后 按照 顺序 计算 名 次 。 自 动 
筛选 功能 ， 主 要 使 用 在 各 个 查询 模块 ， 结 合 窗 体 获取 筛选 条 件 ， 然 后 使 用 自动 筛选 产生 查询 
结果 。 数 据 有 效 性 功能 ， 主 要 使 用 在 需要 输入 年 级 与 班级 的 输入 工作 表 中 ， 以 确保 输入 的 年 
级 与 班级 都 是 在 年 级 与 班级 设置 表 中 存在 的 ， 从 而 保证 数据 输入 的 正确 性 。 

在 成 绩 输入 与 分 析 模 块 中 的 成 绩 输入 功能 模块 中 ， 设 计 了 求 总 分 、 计 算 班 级 名 次 以 及 保 
存 班级 成 绩 数据 表 功 能 。 对 于 已 保存 的 班级 成 绩 数据 表 ， 总 分 和 名 次 是 静态 数据 。 当 需要 如 
新 修改 时 需要 重新 将 数据 返回 成 绩 输入 界面 ， 所 以 设计 了 成 绩 再 处 理 功能 模块 。 使 使 用 者 能 
针对 需要 对 成 绩 做 出 修改 ， 然 后 重新 产生 总 分 与 班级 名 次 。 


串 


5.1.2 ”知识 点 一 : 数据 有 效 性 


数据 有 效 性 设置 可 以 通过 菜单 选择 也 可 以 通过 VBA 来 控制 。 使 用 菜单 操作 时 ， 首 先 选择 
【数据 】 菜 单 ， 在 【数据 工具 】 区 域 选择 【数据 有 效 性 】 命 令 (如 图 5-2 所 示 ) ， 然 后 在 弹出 
的 下 拉 菜 单 中 选择 【数据 有 效 性 】 命 令 ( 如 图 5-3 所 示 ) ， 此 时 即 可 在 弹出 的 【数据 有 效 】 性 
窗口 中 进行 有 效 性 设置 (如 图 5-4 所 示 ) 。 


| 国 有 效 全 VM).- 
| 三 过 BD 
有 效 性 已) 
图 5-2 【数据 有 效 性 】 菜 单 图 5-3 【数据 有 效 性 】 菜 单项 
| 
村]| 输入 信息 | 出 村 警告 | 输入 法 模式 | 
有 效 性 条 件 
净 话 骸 : 
[EEC 


厂 对 有 同样 计生 的 所 有 其 他 单元 格 应 用 这 些 更 改 他) 


EE mw | 


图 5-4 设置 数据 有 效 性 


数据 有 效 性 的 VBA 对 象 是 Validation， 该 对 象 常用 的 方法 是 Add， 下 面 是 其 具体 应 用 的 
一 个 VBA 代码 实例 : 


Range("e5").Validation .Add Type:=xlValidateList，_ "设置 数据 有 效 性 类 型 〈 必 需 ) 
AlertStyle:=xlValidAlertStop，_ "设置 有 效 性 检验 警告 样式 〈 可 选 ) 


< 
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Operator= xlBetween, _ "设置 数据 有 效 性 运算 符 〈 可 选 ) 
Formula1:="1,2,3,4,5,6,7,8" "设置 数据 有 效 性 公式 代码 说 明 : 


Add 方法 中 只 有 Type 属性 是 必需 的 ， 它 指定 数据 有 效 性 的 类 型 ， 对 应 于 设置 窗口 的 “人 允 
许 ” 下 拉 列 表 框 ， 例 如 上 面 实 例 中 设置 的 序列 形式 xlValidateList 。 该 属性 可 取 值 还 有 
xlValidateCustom 〈 自 定义 ) 、xlValidateDate 〈 日 期 ) 、xlValidateDecimal (小 数 ) 、 
xlValidateInputOnly (任意 值 )、xlValidateTextLength (文本 长 度 ) 、xlValidateTime 时间) 、 
xlValidateWholeNumber (整数 ) 。 

AlertStyle 参数 用 来 设置 有 效 性 检验 警告 样式 ， 其 取 值 可 以 为 xIValidAlertInformation、 
xlValidAlertStop 或 xlValidAlertWarning。 

Operator 参数 用 来 设置 数据 有 效 性 运算 方式 ， 对 应 于 设置 窗口 的 “数据 ”下 拉 列 表 框 。 对 
于 序列 形式 , 它 是 固定 的 ， 即 xlBetween ( 介 于 ), 其 可 取 值 可 以 为 xlIBetween ( 介 于 ) 、xlEqual 

(等 于 ) 、xlGreater (大 于 ) 、xlGreaterEqual (大 于 等 于 ) 、xlLess (小 于 ) 、xlLessEqual (小 

于 等 于 ) 、xlNotBetween 〈 未 介 于 ) 或 xINotEqual (不 等 于 ) 。 
Formulal 参数 用 来 设置 数据 有 效 性 公式 的 第 一 部 分 。 如 果 设 置 的 是 字符 串 序 列 ， 则 使 用 
“,” 隔 开 序列 值 。 


5.1.3 ”知识 点 二 : 自动 筛选 


自动 筛选 是 Excel 2007 自 带 的 强大 的 数据 查询 与 分 析 功 能 。 通 过 该 功能 ， 对 每 一 个 需要 
筛选 的 数据 列 ， 都 可 以 设置 3 个 以 内 的 筛选 条 件 。 使 用 该 功能 也 可 以 采用 菜单 操作 和 VBA 操 
作 两 种 方式 。 

使 用 菜单 操作 时 ， 首 先 选 中 需要 自动 筛选 的 列 〈 如 果 不 选择 ，Excel 2007 会 自动 确定 需要 
筛选 的 列 ) 。 然 后 选择 【数据 】 菜 单 ， 在 【排序 和 筛选 】 中 单 击 【筛选 】 按 钮 (如 图 5-5 所 示 ) 。 
此 时 该 数据 列 将 开启 自动 筛选 ， 并 且 标 题 单 元 格 右 下 角 多 了 一 个 下 拉 箭 头 。 单 击 该 下 拉 箭 头 
即 可 设置 自动 筛选 《如 图 5-6 所 示 ) 。 
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5-5 【筛选 】 按 钮 图 5-6 ”筛选 列 下 拉 菜 单 


办 公 应 用 闫 党 之 狗 


Excel VBA 应 用 开发 经 典 案例 


图 中 前 面 3 个 选项 是 用 来 设置 排序 方式 的 。 单 击 【 文 本 筛选 】 按钮 后 弹出 其 二 级 菜单 (如 
图 5-7 所 示 ) ， 在 此 选择 对 应 的 筛选 条 件 方式 。 选 择 【 自 定义 筛选 】 命 令 后 弹出 【 自 定 义 自 动 
筛选 方式 】 对 话 框 〈 如 图 5-8 所 示 ) 。 也 可 以 在 如 图 5-6 所 示 的 复 选 框 中 选中 需要 筛选 的 值 。 
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图 5-7 文本 筛选 二 级 菜单 图 5-8 自 定义 自动 筛选 方式 


下 面 是 一 个 VBA 代码 实例 : 


With Columns("A:D") 
.AutoFilter "开启 自动 筛选 
.AutoFilter Field:=1, Criteria1:="SS”" ' 筛 选 A 列 中 等 于 "SS" 的 单元 格 


.AutoFilter Field:=4, Criteria1:="=*Auto *"， 筛选 D 列 中 包含 "Auto" 字 符 串 的 单元 格 


Operator=xlAnd 
End With 
代码 首先 对 当前 表 的 A 到 D 列 开启 自动 筛选 ， 然 后 设置 第 一 列 〈A 列 ) 筛选 条 件 为 : 等 


于 “SS” 的 项 目 ， 设 置 第 四 列 〈D 列 ) 筛选 条 件 为 :包含 Auto 字符 串 的 项 目 。 整 个 筛选 的 条 
件 就 是 ;筛选 出 A 列 中 等 于 “SS”、D 列 中 包含 Auto 字符 串 的 项 目 。 

Operator 标记 筛选 的 运算 方式 。 它 的 取 值 为 xLAnd (和 ， 该 运算 方式 为 默认 运算 方式 ) 、 
xlBottom1l0Items (后 10 项 ) 、xlBottom10Percent (后 10% 项 ) 、xlOr (或 ) 、xlTop10Items 
(前 10 项 ) 、xlTop10Percent〈 前 10% 项 ) 。 


5.1.4 ”知识 点 三 :冻结 窗口 


冻结 窗口 可 以 固定 表 中 的 某 些 列 或 某 些 行 的 数据 ， 保 证 它 不 会 同步 于 滚动 条 的 滚动 。 这 
样 可 以 方便 浏览 数据 。 比 如 通常 把 表 的 标题 列 固定 下 来 ， 以 便于 向 下 浏览 数据 时 ， 标 题 列 一 
直 存 在 。 

手动 操作 冻结 窗口 时 ， 首 先 选 中 某 个 单元 格 ， 然 后 选择 【视图 】 菜 单 ， 在 【窗口 】 区 域 
中 单 击 【 冻 结 窗口 按钮 (如 图 5-9 所 示 ) ， 弹 出 【冻结 窗口 】 的 二 级 菜单 〈 如 图 5-10 所 示 ) ， 
这 里 选择 【冻结 拆 分 窗 格 】 选 项 。 此 时 ， 选 择 的 单元 格 上 部 与 左 部 的 区 域 为 固定 区 域 ， 该 单 
元 格 下 部 以 及 右 部 〈 包 括 本 身 ) 为 可 滚动 区 域 。 

【冻结 窗口 】 的 二 级 菜单 中 其 他 两 个 按钮 分 别 用 来 将 首 行 和 首 列 冻结 ， 是 一 种 快捷 的 冻 
结 标题 行 和 标题 列 的 方式 。 


选择 A2 单元 格 ， 然 后 选择 【冻结 拆 分 窗 


】 选 项 和 直接 选择 【冻结 首 行 】 选 项 的 结果 一 


致 。 选 择 Bl 单元 格 , 然后 选择 【冻结 拆 分 窗 


】 选 项 和 直接 选择 【冻结 首 列 】 选 项 的 结果 一 致 。 


冻结 窗口 后 , 再 次 进入 【冻结 窗口 菜单 时 , 【冻结 拆 分 窗口 】 已 变 成 【取消 冻结 窗 格 】， 


Bh 
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再 选择 该 选项 可 以 取消 冻结 窗口 。 


硬 


图 5-9 【冻结 窗口 】 按 钮 图 5-10 冻结 窗口 二 级 菜单 
冻结 窗口 的 VBA 代码 如 下 : 


ActiveWindow.FreezePanes = True 
5.1.5 知识 点 四 : End 属性 


使 用 单元 格 的 End 属性 将 会 得 到 一 个 单元 格 区 域 对 象 。 这 个 对 象 代表 包含 源 单元 格 区 域 
的 区 域 尾 端的 单元 格 。 它 等 同 于 在 Excel 中 使 用 Ctrl+ 方 向 键 〈 包 括 向 上 键 、 向 下 键 、 向 左 键 
和 向 右键 ) 的 功能 。 下 面 是 该 属性 VBA 使 用 的 一 个 实例 : 

Worksheets("Sheet1").Activate ' 激 活 Sheet1 

Range("B4").End(xIToRight).Select ' 从 B4 单元 格 向 右 跳 到 包含 B4 的 非 空 区 域 的 尾部 

该 示例 首先 激活 Sheetl 表 , 然后 自 B4 单元 格 向 右 定位 到 包含 B4 的 非 空 区 域 的 尾 端 。End 
的 方向 参数 常量 有 xlIDown( 向 下 键 )，xlToRight (向 右键 ) ，xlToLeft (向 左 键 ) ，xlUp (向 
上 键 )。 以 下 代码 通常 用 来 获取 表格 中 有 数据 区 域 的 最 大 行 数 。 

.Cells(Rows.Count,1).End(xlup).Row 


5.1.6 ”知识 点 五 :Sort 方 法 


Sort 方法 可 以 对 某 列 或 多 个 列 按 指定 方式 进行 排序 。 在 Excel 2007 的 【数据 】 菜单 栏 中 可 
以 找到 【排序 】 按 钮 ， 该 按钮 可 用 来 手动 完成 排序 设置 。 排 序 也 可 以 通过 代码 完成 ， 该 代码 
的 参数 众多 ， 但 是 所 有 参数 都 是 可 选 的 。 以 下 是 该 方法 的 语法 格式 : 
Range.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, 
Orientation, SortMethod, DataOption1, DataOption2, DataOption3) 
口 Keyl 参数 : 指定 第 一 排序 字段 ， 作 为 区 域名 称 (字符 串 ) 或 Range 对 象 ; 确定 要 排 
序 的 值 。 
Orderl 参数 : 确定 Keyl 中 指定 的 值 的 排序 次 序 。 
Key2 参数 : 第 二 排序 字段 ， 对 数据 透视 表 进行 排序 时 不 能 使 用 。 
Type 参数 : 指定 要 排序 的 元 素 。 
Order2 参数 : 确定 Key2 中 指定 的 值 的 排序 次 序 。 
Key3 参数 : 第 三 排序 字段 ， 对 数据 透视 表 进行 排序 时 不 能 使 用 。 
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口 ”Order3 参数 : 确定 Key3 中 指定 的 值 的 排序 次 序 。 

口 、Header 参数 : 指定 第 一 行 是 否 包含 标题 信息 。xlNo 是 默认 值 ; 如果 希望 Excel 确定 
标题 ， 则 指定 xlGuess。 

口 ”OrderCustom 参数 : 指定 在 自 定 义 排序 次 序列 表 中 的 基于 1 的 整数 偏 移 。 

口 MatchCase 参数 : 设置 为 True， 执 行 区 分 大 小 写 的 排序 ， 设 置 为 False， 则 执行 不 区 
分 大 小 写 的 排序 。 不 能 用 于 数据 透视 表 。 

口 “Orientation 参数 : 指定 以 升序 还 是 降序 排序 

口 “SortMethod 参数 : 指定 排序 方法 。 

口 “DataOptionl 参数 : 指定 Keyl 中 所 指定 区 域 中 的 文本 的 排序 方式 。 不 能 用 于 数据 透 
视 表 排序 。 

口 DataOption2 参数 : 指定 Key2 中 所 指定 区 域 中 的 文本 的 排序 方式 。 不 能 用 于 数据 透 
视 表 排序 。 

口 DataOption3 参数 : 指定 Key3 中 所 指定 区 域 中 的 文本 的 排序 方式 。 不 能 用 于 数据 透 
视 表 排序 。 


5.2 首页 设计 
本 例 的 首页 使 用 形状 图 形 进行 跳 转 工作 ， 单 击 相 应 功能 块 的 自选 图 形 就 会 执行 相应 的 跳 
转子 模块 。 界 面 中 共 包 含 了 10 个 形状 图 形 ， 其 中 有 9 个 圆 角 矩形 作为 跳 转 按钮 ， 还 有 1 个 算 
形 则 作为 整个 首页 的 外 边框 。 外 边框 中 还 包含 了 3 个 分 组 框 。 这 3 个 分 组 框 分 别 用 于 分 隔 开 
不 同 功能 分 类 的 按钮 。 该 首页 的 界面 效果 如 图 5-11 所 示 。 


学 生成 绩 管 理 求 纺 


厂 基本 资料 建立 


Ce ee) ey) 


| 成 绩 镁 入 与 分 析 


三 要 泗 


图 5-11 首页 界面 效果 图 
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首页 中 不 包含 任何 代码 ， 所 以 本 部 分 将 该 界面 的 建立 步骤 不 再 单独 列 一 小 节 加 以 介绍 。 


以 下 是 该 界面 的 具体 建立 步骤 : 


(1) 建立 界面 外 边框 。 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】|【 算 形 】|【 和 矩形 】 
命令 。 在 首页 的 空白 区 域 单 击 鼠 标 左 键 并 按 住 不 放 向 右 下 方 拖 动 ， 到 适当 大 小 时 释放 鼠标 ， 
即 可 生成 一 个 和 矩形 外 边框 。 该 矩形 将 作为 整个 首页 界面 的 外 框 。 

(2) 设置 界面 外 边框 。 右 击 和 矩形 外 边框 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 ， 
如 图 5-12 所 示 。 然 后 输入 文字 内 容 为 “学 生成 绩 管理 系统 ”。 

(3) 选中 在 矩形 外 边框 中 输入 的 文字 并 右 击 。 在 随后 弹出 的 快捷 菜单 中 选择 【字体 】 命 
令 ， 如 图 5-13 所 示 。 此 时 将 会 打开 【字体 】 对 话 框 ， 如 图 5-14 所 示 。 在 【字体 】 选 项 卡 中 将 
字体 设置 为 “华文 彩云 ”， 字 号 为 20。 然 后 再 次 右 击 和 矩形 外 边框 ， 在 弹出 的 快捷 菜单 中 选择 
【设置 形状 格式 】 菜 单项 ， 如 图 5-12 所 示 。 在 【设置 形状 格式 】 窗 口中 选择 【文本 框 】 项 目 ， 
然后 设置 垂直 对 齐 方式 为 “顶端 对 齐 ”， 如 图 5-15 所 示 。 


设置 为 默认 形状 (D) 
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图 5-12 编辑 形状 文字 
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图 5-14 设置 界面 外 边框 字体 属性 
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图 5-13 设置 字体 
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图 5-15 设置 界面 外 边框 对 齐 属性 


(4) 建立 分 组 框 。 在 Excel 2007 中 依次 选择 【开发 工具 】|【 插 入 】| 【表单 控件 】| 【分 
组 框 】 命 令 。 在 第 4 章 中 已 经 介绍 了 如 何 调 出 【开发 工具 】 选 项 卡 ， 这 里 不 再 说 明 。 随 后 在 
系统 首页 界面 矩形 的 内 部 连续 建立 3 个 分 组 框 ， 然 后 分 别 右 击 3 个 分 组 框 ， 在 弹出 的 快捷 菜 
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单 中 选择 【编辑 文字 】 命 令 ， 如 图 5-12 所 示 。 将 3 个 分 组 框 的 文字 内 容 分 别 设置 为 “基本 资 
料 建立 ”、“ 成 绩 输入 与 分 析 ” 和 “查询 ”， 如 图 5-11 所 示 。 

(5) 建立 各 模块 跳 转 按钮 。 按 钮 都 是 使 用 形状 图 形 来 完成 的 ， 下 面 只 讲述 第 一 个 按钮 
“学 生 名 单 建立 ”的 制作 步骤 ， 其 他 按钮 以 此 类 推 。 首 先 在 Excel 2007 中 依次 选择 【插入 】| 
【形状 】| 【矩形 】|【 圆 角 算 形 】 命 令 。 随 后 在 【基本 资料 建立 】 分 组 框 中 拖 动 出 一 个 适当 大 
小 的 圆 角 和 矩形。 

(6) 设置 跳 转 按钮 。 右 击 创建 的 圆 角 甜 形 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 ， 
如 图 5-12 所 示 。 然 后 输入 文字 内 容 为 “学 生 名 单 建 立 ”。 随 后 再 次 右 击 该 圆 角 矩 形 ， 在 弹出 
的 快捷 菜单 中 选择 【设置 形状 格式 】 命 令 ， 如 图 5-12 所 示 。 随 后 将 打开 【设置 形状 格式 】 对 
话 框 。 然 后 在 【设置 形状 格式 】 对 话 框 中 选择 【填充 】 项 目 ， 如 图 5-16 所 示 ， 在 填充 设置 中 
选中 【渐变 填充 】 单 选 按钮 。 然 后 再 展开 【颜色 】 下 拉 列 表 框 并 选择 【橙黄 ， 强 调 文字 颜色 6， 
淡色 40%】 项 目 ， 如 图 5-17 所 示 。 


SS 


EE x 


图 5-16 设置 填充 效果 图 5-17 填充 颜色 设置 


(7) 设置 按钮 的 宏 过 程 。 按 钮 和 相应 的 过 程 代码 完成 后 ， 需 要 将 这 些 按钮 及 其 单 击 时 相 
应 的 过 程 对 应 起 来 。 首 先 右 击 【 学 生 名 单 建立 】 按 钮 ， 在 弹出 的 快捷 菜单 中 选择 【指定 宏 】 
命令 , 如 图 5-18 所 示 。 随 后 将 打开 【指定 宏 】 对 话 框 ， 如 图 5-19 所 示 。 在 该 对 话 框 的 【 宏 名 】 
列表 框 中 选择 已 经 建立 好 的 过 程 ， 这 里 选择 已 创建 好 的 宏 XSMD 即 可 。 
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5.3 基本 资料 建立 模块 设计 


基本 资料 建立 模块 用 于 完成 系统 的 基础 资料 信息 建立 。 该 模块 完成 的 工作 包括 学 生 名 单 
建立 ， 教 师资 料 建立 ， 班 级 年 级 资料 的 建立 。 这 些 工作 分 别 由 首页 基本 资料 建立 分 组 框 中 的 
三 个 按钮 完成 。 这 3 个 子 功能 模块 的 描述 如 下 : 

口 “学生 名 单 建立 子 模块 : 该 子 模块 用 于 建立 学 生 基本 信息 。 单 击 首页 中 的 【学 生 名 单 
i 将 激活 学 生 名 单 工 作 表 。 该 表 包 含 了 4 个 限定 学 生 信息 的 数据 列 ， 

分 别 是 学 号 、 年 级 、 班 级 名 和 学 生 名 。 用 户 建立 学 生 信息 时 ， 可 以 直接 在 数据 末端 

输入 新 的 学 生 信息 
口 教师 资料 建立 子 模块 : 该 子 模块 用 于 建立 教师 基本 信息 。 单 击 首页 中 的 【教师 资料 

建立 】 按 钮 后 ， 将 激活 教师 资料 工作 表 。 该 表 包 含 了 11 个 数据 列 ， 分 别 是 教师 名 、 

班主 任 、 语 文 、 数 学 、 英 语 、 政 治 、 生 物 、 物 理 、 化 学 、 历 史 和 地 理 。 用 户 需 要 输 

入 的 是 教师 的 名 称 以 及 相应 教授 课程 下 的 班级 名 称 。 

口 ”班级 年 级 资料 建立 子 模块 ， 该 子 模块 用 于 建立 学 校 年 级 与 班级 名 资料 。 表 中 年 级 名 

列 是 非 重 复 的 年 级 名 称 ， 而 班级 名 列 中 存储 了 所 有 班级 的 名 称 ， 这 些 名 称 还 包含 了 

年 级 信息 。 


5.3.1 ”学生 名 单 表 设 计 


学 生 名 单 表 主要 用 于 管理 学 生 学 号 、 年 级 、 班 级 名 称 以 及 学 生 名 信息 。 该 表 用 于 存储 学 
校 所 有 学 生 的 相关 信息 。 其 允许 保存 的 学 生 数 量 是 6 万 多 ， 对 于 普通 的 学 校 已 经 够 用 。 学 生 
名 单 表 界面 如 图 5-20 所 示 。 这 些 信息 被 建立 后 ， 用 户 可 以 通过 查询 模块 查询 具体 班级 或 某 学 
号 的 学 生 信 息 。 查 询 学 生 资料 时 是 采用 自动 筛选 的 方式 筛选 对 应 的 学 生 学 号 、 年 级 、 班 级 名 
称 、 学 生 名 列 。 查 询 的 功能 请 参见 后 续 小 节 的 介绍 。 
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Pe 
图 5-20 学 生 名 单 表 界面 


当 要 建立 新 的 学 生 名 单 时 ， 用 户 首先 在 首页 单 击 【 学 生 名 单 建 立 】 按 钮 。 单 击 该 按钮 时 ， 
程序 将 执行 XSMD 过 程 。 该 过 程 用 于 激活 学 生 名 单 表 以 及 对 学 生 表单 的 年 级 列 的 数据 有 效 性 
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进行 初始 化 设置 。 下 面 是 设置 数据 有 效 性 的 程序 流程 。 

首先 程序 从 年 级 班级 表 中 获取 所 有 年 级 的 序列 ， 注 意 该 年 级 序列 是 使 用 逗号 相互 连接 的 ; 
然后 程序 将 该 需要 设置 数据 有 效 性 的 区 域 的 有 效 性 设置 清除 ， 最 后 使 用 新 的 有 效 性 序列 设置 
该 区 域 的 数据 有 效 性 。 如 图 5-21 所 示 的 是 该 过 程 的 流程 图 。 


年 级 班级 表 中 年 级 列 最 后 一 记录 的 行 号 rowsCount 


oo 


是 


连接 有 效 性 序列 


修正 有 效 性 序列 
删除 区 域 有 效 性 设置 
为 区 域 设置 新 的 有 效 性 


图 5-21 ”学生 名 单 过 程 流程 图 


Sub XSMD( 
Dim rg As Range, strCell As String, rowsCount As Integer, i As Integer 
Sheet2.Activate "激活 学 生 名 单 表 


Set rg = Sheet2.Range(Cells(2, 2), Cells(Rows.Count, 2)) "获取 需要 设置 数据 有 效 性 的 区 域 
rowsCount = Sheet6.Cells(Rows.Count, 1).End(xIUp).Row ”' 获 取 年 级 班级 表 中 年 级 列 最 后 一 记录 


的 行 号 

Fori= 2 To rowsCount "循环 所 有 年 级 名 称 

strCell = strCell & "," & Sheet6.Cells(i, 1) "连接 年 级 序列 
Next 
strCell = Right(strCell, Len(strCell) -1) "清除 年 级 序列 中 多 余 的 逗号 
With rg.Validation 

.Delete "清除 区 域 的 数据 有 效 性 

为 区 域 添加 数据 有 效 性 

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=strCell 
End With 
Set rg = Nothing 
End Sub 


上 述 过 程 执行 完成 后 ， 系 统 当前 被 激活 的 工作 表 即 为 学 生 名 单 表 。 该 表 的 界面 并 不 复杂 ， 
在 学 生 名 单 表 中 设置 了 一 个 【返回 】 按 钮 用 于 跳 转 回 首页 。 该 按钮 的 建立 类 同 于 前 面 介绍 首 
页 时 的 跳 转 按钮 。 选 择 该 按钮 时 程序 将 执行 位 于 “菜单 跳 转 代码 ”模块 的 RetumMain 过 程 。 
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该 过 程 的 代码 如 下 : 

Sub ReturnMain() 

Sheet5.Activate 激活 首页 表 

End Sub 

在 该 表 中 为 了 辅助 用 户 快 速 输入 资料 ， 不 仅 对 年 级 列 设 置 了 有 效 性 ， 而 且 也 为 班级 列 设 
置 了 有 效 性 。 设 置 年 级 列 的 有 效 性 是 在 工作 表 被 激活 时 完成 的 ， 而 班级 列 有 效 性 设置 是 用 户 
修改 相应 的 年 级 信息 时 完成 的 。 因 而 在 该 工作 表 中 就 包含 了 一 个 Worksheet_Change 事件 。 

程序 根据 工作 表 改 变 事 件 中 获得 的 Target 单元 格 区 域 对 象 ， 判 断 用 户 做 出 的 改变 是 否 在 
工作 表 的 B 列 。 当 是 B 列 时 ， 程 序 从 年 级 班级 表 中 获取 当前 选择 年 级 下 的 所 有 班级 ， 然 后 将 
这 些 班级 连接 起 来 作为 一 个 新 的 数据 有 效 性 序列 。 随 后 将 该 序列 作为 有 效 性 序列 设置 给 右 侧 
的 班级 名 单元 格 。 该 过 程 的 流程 如 图 5-22 所 示 。 


一 一 要 化 的 单元 格 是 否 位 于 B 列 一 一 
获取 学 校 班 级 总 数 rowsCount 


第 i 行 班级 是 否 在 当前 年 级 下 ? 


连接 数据 有 效 性 字符 串 | 


修正 数据 有 效 性 字符 串 


删除 单元 格 数据 有 效 性 设置 
添加 单元 格 数据 有 效 性 设置 


图 5-22 ”学 生 名 单 表 改变 过 程 流程 图 
以 下 是 该 过 程 的 代码 解释 : 
Private Sub Worksheet_Change(ByVal Target As Range) 


Dim rg As Range "存储 需 设 置 数据 有 效 性 的 单元 格 

Dim strCell As String ' 存 储 筛 选 条 件 的 字符 串 

Dim rowsCount As Integer "存储 最 大 表 行 数 

Dimi As Integer "循环 计数 变量 

On Error GoTo Exit_sub ' 当 出 现 错误 时 ， 跳 转 到 过 程 示 尾 
IfTarget.Column = 2 Then ' 当 改变 的 是 B 列 数据 时 ， 继 续 执行 后 续 代 码 


"计算 年 级 班级 表 最 后 一 个 班级 数据 所 在 行 数 
rowsCount = Sheet6.Cells(Rows.Count, 2).End(xIUp).Row 
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将 Target 指定 的 年 级 所 对 应 的 所 有 班级 序列 写 入 其 右边 班级 单元 格 数据 有 效 性 序列 中 
Fori= 2 To rowsCount 
' 检 查 从 年 级 班级 表 中 获得 的 班级 是 否 属于 当前 单元 格 对 应 年 级 
If Left(Sheet6.Cells(i, 2), Len(Target)) = Target Then 
' 将 满足 条 件 的 班级 名 写 入 strCell 字符 串 ， 以 备 设置 数据 有 效 性 
strCell = strCell & "," & Sheet6.Cells(i, 2) 


End 上 f 
Next 
strCell = Right(strCell, Len(strCell) -1) ' 去 掉 strCell 最 前 面 多 出 的 分 割 号 
Set rg = Sheet2.Cells(Target.Row, 3) ' 定 义 需 要 设置 数据 有 效 性 的 单元 格 


以 下 代码 参见 数据 有 效 性 知识 点 介绍 
With rg.Validation 


.Delete ' 删 除 单元 格 有 效 性 设置 

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop，_ 
Operator:=xlBetween, Formula1:=strCell "允许 单元 格 接受 序列 中 所 有 值 
End With 
End If 
Set rg = Nothing 
Exit_sub: 
End Sub 


5.3.2 教师 与 科目 设置 表 设 计 


在 首页 单 击 【教师 资料 建立 】 按 钮 后 ， 将 会 跳 转 到 教师 资料 表 。 该 表 主 要 用 于 完成 存储 
教师 名 称 ， 教 师 任职 科目 信息 工作 。 这 些 建 立 的 信息 可 以 被 查询 模块 调用 。 该 表 的 界面 如 
图 5-23 所 示 。 

国 学 生 或 请 芝 理 系 纺 工 


B 9 3 区 
1 牧师 名 回 班主 任 回 语 文 ”国教 学 回 英 话 ”加 政治 ”国生 物 ” 回 攀 理 同化 学 回 历史 回 地 理 区 
[证 


10 和 加 举 刀 年 级 3H 
12 | 英 伍 ; 
MW 4 有 首页 | 执 师 总 笠 ， 学 生 训 间 “大 初 二 年 级 ;更 ， 成 绩 输 入 表 ， 手 绩 拌 名， 和 级 得 绒 表 JE 


图 5-23 ”教师 资料 表 界 面 


表 中 包含 了 一 个 Worksheet BeforeDoubleClick 事件 ， 该 事件 主要 用 来 辅助 输入 数据 。 当 
用 户 在 该 工作 表 中 双击 输入 区 的 某 个 单元 格 时 ， 会 弹出 一 个 辅助 输入 窗口 ， 例 如 需要 设置 彭 
平 芳 老 师 担 任 七 年 级 2 班 的 班主 任 。 输 入 时 可 以 双击 B2 单元 格 ， 然 后 会 弹出 一 个 窗口 。 在 窗 
口 的 选择 年 级 与 选择 班级 文本 框 中 分 别 输入 年 级 与 班级 即 可 。 有 关 该 窗口 的 详细 介绍 ， 请 见 
后 续 窗口 代码 设计 的 年 级 班级 选择 窗口 设计 部 分 。 以 下 是 该 工作 表 的 双击 事件 代码 : 

Private Sub Worksheet BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 


判断 是 否 在 表 的 B 到 K 列 双击 ， 该 范围 都 是 可 以 进行 输入 班级 信息 的 区 域 
If Len(Sheet1.Cells(Target.Row, 1)) And Target.Column > 1 And Target.Column < 12 Then 


LA 


-~ 


第 5 章 学 生成 绩 特困 科 纹 人 


frmXSMD.Show 显示 辅助 输入 窗口 
If Len(Target) Then 判断 被 双击 单元 格 内 容 是 否 非 空 

Target = Target & " " & tempBJ "如 果 非 空 ， 将 输入 结果 添加 到 原 内 容 后 
Else 

Target = tempBJ ' 如 果 为 空 ， 直 接 将 结果 写 入 被 双击 单元 格 
End 上 f 
End 上 f 
End Sub 


5.3.3 年 级 班级 设置 表 设计 


年 级 班级 设置 表 与 学 生 资料 、 教 师资 料 表 的 界面 十 分 类 似 。 该 表 中 包含 了 两 个 数据 列 ， 分 
别 是 年 级 名 和 班级 名 。 该 首 行 标题 被 冻结 ， 当 用 户 在 查看 或 输入 年 级 名 与 班级 名 时 ， 首 行 标题 
不 会 移动 。 另 外 该 表 还 包含 了 一 个 跳 转 到 首页 的 返回 按钮 。 该 表 的 设置 界面 如 图 5-24 所 示 。 

在 该 工作 表 的 代码 中 也 应 用 了 工作 表 的 改变 事件 。 该 事件 用 于 确认 输入 的 年 级 名 、 班 级 
名 是 否 有 重复 项 目 ， 以 确保 输入 数据 的 正确 性 。 程 序 根据 发 生 改变 单元 格 所 处 列 号 确认 是 对 
年 级 名 列 还 是 班级 名 列 进行 了 重复 性 检查 。 对 不 同 列 检查 的 方式 是 一 样 的 ， 程 序 逐 个 检测 该 
列 的 各 个 数据 是 否 与 新 输入 数据 一 致 ， 当 一 致 时 ， 记 录 下 重复 次 数 。 当 检查 完 所 有 单元 格 后 ， 
如 果 该 重复 次 数 不 超 过 1， 则 说 明 没有 重复 项 目 ， 否 则 存在 重复 项 目 。 如 图 5-25 所 示 的 是 该 
过 程 中 对 年 级 列 进行 重复 性 检查 的 流程 图 。 


获取 年 级 班级 表 年 级 名 列 末 条 数据 行 号 rowsCount 


=2 
< 否 
一 一 省 行 年 级 是 否 与 输入 重复 


I = 
a B 6 D E B 6 图 

1 年级 名 。 班级 名 

2 _ 九 年 级 九 年 级 1 得 

3 _ 初 二 年 级 
七 年 级 


18 有 
19 
MT 首页 。 教 厂 效 料 ”学 生 委 前 CJ- 祈 二 年 师 1 斑 ] 


图 5-24 ”年 级 班级 设置 表 界面 


图 5-25 ”判断 年 级 输入 是 否 重复 流程 图 
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以 下 是 工作 表 改 变 事件 的 代码 解释 : 
Private Sub Worksheet_Change(ByVal Target As Range) 


Dim rowsCount As Integer "保存 表 的 最 大 行 数 

Dim i As Integer "循环 计数 变量 

Dim sameCount As Integer "保存 班级 或 年 级 重复 项 重复 次 数 
' 检 查 年 级 输入 是 否 有 重复 


If Target.Column = 1 Then 
' 获 取 以 输入 年 级 数据 的 最 后 行 的 行 号 
rowsCount = Sheet6.Cells(Rows.Count, 1).End(xIUp).Row 
Fori= 2 To rowsCount 
' 当 检测 的 单元 格 与 当前 变化 单元 格 内 容 相同 时 ， 将 计数 器 增加 1 
If Sheet6.Cells(i, 1) = Target Then 
sameCount = sameCount + 1 
End If 
Next 
' 当 计数 器 大 于 1 时 (计算 时 ， 还 计算 了 本 身 ) ， 可 以 判断 该 输入 的 年 级 已 经 存在 
lfsameCount > 1 Then 
MsgBox "该 年 级 已 经 存在 ! ", vblnformation + vbOKOnly 
Target.Clear 
End ff 
End If 
班级 的 检测 方法 同年 级 的 检测 方法 
IfTarget.Column = 2 Then 
rowsCount = Sheet6.Cells(Rows.Count, 2).End(xIUp).Row 
Fori= 2TorowsCount 
If Sheet6.Cells(i, 2) = Target Then 
sameCount = sameCount + 1 
End If 
Next 
lfsameCount > 1 Then 
MsgBox "该 班级 已 经 存在 ! ", vblnformation + vbOKOnly 
Target.Clear 
End ff 
End If 


5.4 成绩 输入 与 分 析 模 块 设计 


成 绩 输入 与 分 析 模 块 是 该 实例 的 重点 部 分 。 该 模块 由 3 部 分 构成 ， 分 别 是 成 绩 输入 模块 、 

年 级 排名 模块 以 及 成 绩 再 处 理 模块 。 在 首页 表 中 成 绩 输入 与 分 析 分 组 框 中 包含 的 3 个 按钮 分 
别 对 应 这 3 个 功能 模块 。 以 下 是 这 3 个 功能 模块 的 功能 描述 : 

口 ”成绩 输入 模块 ， 该 模块 主要 完成 班级 学 生成 绩 的 输入 工作 。 用 户 在 首页 中 单 击 【 成 

绩 输 入 】 按 钮 后 弹出 【年 级 班级 选择 】 对 话 框 。 该 步 用 于 确认 用 户 输入 的 年 级 与 班 

级 名 。 如 果 用 户 在 此 前 已 经 建立 了 该 班级 的 学 生 信息 ， 则 程序 将 自动 将 该 班 所 有 学 


104 


_ 


第 5 章 学 生成 绩 入 名 系统 We 


生 信息 自动 复制 到 成 绩 表 中 。 输 入 完 所 有 的 成 绩 信息 后 ， 还 可 以 通过 该 工作 表 中 的 4 
个 按钮 依次 完成 相应 的 功能 ， 分 别 用 于 计算 学 生 的 总 分 、 计 算 班 级 名 次 、 保 存 成 绩 
表 和 返回 首页 。 

口 “年 级 排名 模块 : 年 级 排名 模块 用 于 对 全 年 级 的 学 生成 绩 进 行 排序 。 在 进行 年 级 学 生 
排名 前 ， 需 要 保证 该 年 级 下 所 有 班级 的 成 绩 已 经 建立 并 且 保 存 到 工作 适中 。 单 击 该 
按钮 后 ， 用 户 选择 需要 统计 排名 的 年 级 。 如 果 当 前 选择 年 级 下 有 班级 的 成 绩 信息 未 
建立 ， 程 序 会 提示 该 班级 成 绩 表 未 建立 并 退出 统计 ; 否则 程序 将 完成 该 年 级 所 有 学 
生 的 排名 工作 。 

口 ”成 绩 再 处 理 模块 : 成 绩 再 处 理 模块 用 于 再 次 处 理 已 经 保存 了 的 班级 成 绩 表 。 程 序 中 
已 经 保存 了 的 成 绩 表 没有 包含 算 总 分 、 计 算 班级 名 次 等 功能 。 这 里 通过 将 该 班级 的 
数据 导入 到 成 绩 输入 表 来 完成 班级 成 绩 的 再 处 理 。 当 用 户 需 要 修改 某 个 学 生成 绩 ， 
然后 重新 统计 总 分 、 排 名 时 ， 需 要 通过 该 操作 完成 。 


5.4.1 成 绩 输入 模块 设计 


该 模块 用 于 建立 班级 学 生成 绩 。 它 的 主要 功能 包括 班级 学 生成 绩 的 输入 、 计 算 总 分 、 计 
算 班 级 名 次 以 及 保存 班级 成 绩 表 。 该 表 的 界面 如 图 5-26 所 示 。 该 表 的 界面 简洁 ， 几 个 按钮 的 
建立 可 以 参照 首页 相关 的 内 容 。 
TEN 隔 窑 异 芭 | -ox 


-nr ET WN ON WT ET EE 
学 号 [3 博文 数学 英语 政治 生物 物理 化 学 历史 地 理 总 分 班 名 次 


2006 寺 村， 80 70 710 70 70 7 100 70 670 1 
21007 章 院 锦 80 70 70 70 70 70 70 99 70 669 2 
21013 刘 扰 充 80 70 70 70 70 70 70 7097.5 668 3 
21029 章 健 80 70 70 70 70 70 0955 70 666 4 
21028 莫 交 灿 80 70 70 70 70 7 70 95 70 665 5 
21027 重 亮 呈 830 70 70 70 70 70 70945 70 665 6 
21008 看 兴 训 80 70 70 70 70 70 70 94 70 664 7 

T 

8 


wenarals| 


10 21025 庄 庆 山 80 ?0 0 7 70 70 70 95.5 70 664 
11 21024 真 旅 此 80 ?70 10 70 70 70 70 93 70 663 
12 21003 填 章 杭 80 70 70 70 70 70 70 95 70 663 
13 ?21054 相 明 春 80 70 70 70 70 70 5 70 70 663 
14 21022 章 万 成 80 70 710 70 70 70 70 92 70 662 
15 21053 储 视 正 80 0 70 70 70 70 9 70 70 662 
16 21021 和 草 者 尝 80 70 10 70 70 70 7039.5 70 662 
17 21062 章 常 望 80 3 70 加 To 70 .5 70 70 662 
21020 章 男 80 70 70 70 70 G1 70 661 


1 0 a a ee Maal dle 
图 5-26 成 绩 输 入 表 界 面 


单 击 首页 成 绩 输 入 与 分 析 分 组 框 中 的 【成 绩 输 入 】 [各 入 成 入 地 的 年 伯 与 姑 各 | 
按钮 后 , 将 调用 菜单 跳 转 代码 模块 的 CJSR 过 程 。 该 过 程 


选择 年 级 3 | 初 = 年 级 司 
首先 打开 一 个 询问 年 级 与 班级 的 对 话 框 ( 如 图 5-27 所 a = 
示 ) 。 该 对 话 框 用 于 设置 成 绩 输入 的 年 级 与 班级 名 称 。 寺 Fa 


然后 将 对 应 的 班级 的 所 有 学 生 的 学 号 与 姓名 写 入 成 绩 输 
入 表 中 ， 并 激活 输入 工作 表 。 该 过 程 的 流程 图 如 图 5-28 ”图 5-27 设置 输入 成 绩 的 年 级 与 班级 名 
所 示 。 
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将 该 学 生 信息 写 入 成 绩 输 入 表 


图 5-28 成绩 输入 过 程 流 程 图 


该 过 程 的 详细 代码 解释 如 下 : 


Sub CJSR() 

Dim rowsCount As Integer, i As Integer 

Dim fillRow As Integer "记录 已 经 填充 了 学 号 与 姓名 的 最 大 行 数 
frmXSMD.Caption = "输入 成 绩 班级 的 年 级 与 班级 名 " 

frmXSMD.Show ' 显 示 获取 班级 年 级 名 称 窗口 

Sheet3.Activate ' 激 活 成 绩 输 入 表 

rowsCount = Sheet3.Cells(Rows.Count, 1).End(xIUp).Row "获取 成 绩 输入 表 最 大 行 数 
IfrowsCount > 1 Then 判断 成 绩 输入 表 是 否 已 有 成 绩 数据 存在 


Sheet3.Range(Cells(2, 1), Cells(rowsCount, 13)).ClearContents “清除 已 有 数据 
End If 


' 获 取 学 生 名 单 表 最 大 行 数 

rowsCount = Sheet2.Cells(Rows.Count, 1).End(xIUp).Row 

Fori= 2 To rowsCount "从 学 生 名 单 表 第 二 行 开 始 ， 一 直 循环 到 末尾 
If Sheet2.Cells(i, 3) = tempBJ Then 判断 学 生 所 在 班级 与 输入 的 班级 是 否 对 应 


"获取 已 经 写 入 成 绩 输入 表 的 学 生 资料 的 最 大 行 数 
fillRow = Sheet3.Cells(Rows.Count, 1).End(xIUp).Row 


Sheet3.Cells(filIRow + 1, 1) = Sheet2.Cells(i, 1) ' 将 学 生 学 号 写 入 成 绩 输入 表 
Sheet3.Cells(filIRow + 1, 2) = Sheet2.Cells(i, 4) 将 学 生 名 写 入 成 绩 输入 表 
End If 
Next 
End Sub 


下 面 依次 解释 该 工作 表 中 包含 的 几 个 按钮 的 功能 。 该 工作 表 中 共 包含 了 4 个 按钮 ， 分 别 


Ah 
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是 算 总 分 、 计 算 班 级 名 次 、 保 存 成 绩 表 和 返回 按钮 。 返 回 按钮 的 功能 这 里 不 再 加 以 说 明 ， 前 
面 的 一 些 工作 表 中 有 类 似 的 按钮 。 

口 【 算 总 分 】 按 钮 : 单 击 该 按钮 时 ， 程 序 将 循环 成 绩 输入 表 中 的 所 有 数据 行将 各 个 
学 生 的 总 成 绩 计 算出 来 ， 然 后 将 该 成 绩 保 存 到 【总 分 】 列 中 。 程 序 首先 获取 了 成 
绩 输 入 表 末 端 数据 行 的 行 号 rowsCount， 然 后 使 用 For 循环 从 2 开始 一 直 循环 到 
rowsCount， 将 各 个 科目 的 成 绩 相 加 然后 保存 到 总 分 列 中 。 该 按钮 执行 宏 的 流程 如 
图 5-29 所 示 。 

口 【计算 班级 名 次 】 按 钮 : 单 击 该 按钮 后 ， 将 执行 功能 表 模 块 中 的 Rank 过 程 。 该 过 程 
使 用 了 Excel 2007 的 内 置 功能 Sort 方法 实现 对 班级 学 生成 绩 的 排序 。 关 于 该 方法 的 
知识 介绍 参见 本 章 的 知识 点 五 。 程 序 首 先 使 用 Sort 方法 对 学 生 总 成 绩 按 照 降 序 排列 ， 
然后 再 将 排名 列 依次 从 1 开始 编排 。 该 过 程 的 流程 图 如 图 5-30 所 示 。 


将 学 生成 绩 表 按 学 生 总 分 降序 排列 
获取 学 生成 绩 表 林 端 数据 行 行 号 rowsCount 
将 第 二 行 学 生 的 排名 记 为 1 


图 = 
一 第 i 行 学生 总 分 与 -1 行 学 生 总 分 是 否 相 同 ? 


获取 成 绩 输 入 表 末 端 数据 行 的 行 号 owsCount 


图 5-29 算 总 分 过 程 流程 图 图 5-30 计算 学 生 名 次 过 程 流程 图 


口 【保存 成 绩 表 】 按 钮 : 单 击 该 按钮 后 ， 将 会 执行 功能 表 模块 中 的 SaveData 过 程 。 此 
过 程 首先 会 弹出 一 年 级 班级 输入 窗口 。 用 户 在 该 窗口 输入 成 绩 表 所 属 年 级 班级 名 。 
当成 功 获取 年 级 班级 名 后 ， 过 程 将 新 建 一 个 工作 表 。 如 果 该 年 级 班级 的 成 绩 表 已 经 
存在 ， 程 序 首先 删除 该 表 ， 然 后 再 添加 新 工作 表 ， 最 后 过 程 将 成 绩 数 据 复 制 到 新 的 

工作 表 中 。 该 过 程 的 流程 图 如 图 5-31 所 示 。 
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显示 年 级 班级 获取 窗口 
取得 当前 选择 班级 的 工作 表 对 象 ws 


删除 ws 工作 表 四 
添加 新 工作 表 


设置 新 工作 表 表 名 


从 成 绩 输入 表 中 复制 数据 


调整 新 工作 表 列 


图 5-31 ”保存 成 绩 过 程 流程 图 


以 下 是 算 总 分 按钮 的 详细 代码 解释 : 


Sub CalTotal() 


Dim rowsCount As Integer ' 保 存 表 的 最 大 行 数 
Dim i As Integer 一 次 循环 计数 变量 
Dimj As Integer ' 二 次 循环 计数 变量 
Dim total As Double ' 保 存 总 分 


获得 成 绩 输 入 表 当 前 已 建立 数据 最 后 一 行 的 行 号 
rowsCount = Sheet3.Cells(Rows.Count, 1).End(xIUp).Row 
' 对 已 输入 成 绩 的 行 ， 将 各 科 成 绩 汇总 ， 然 后 写 入 对 应 的 总 分 列 中 


Fori= 2 To rowsCount 
Forj=3To11 


total = total + Sheet3.Cells(i, j) 


Next 
Sheet3.Cells(i, 12) = total 
total = 0 

Next 

End Sub 


' 在 每 次 计算 完 一 行 的 总 分 后 ， 需 要 将 存储 总 分 的 临时 变量 置 0 


以 下 是 计算 班级 名 次 按钮 的 详细 代码 解释 : 


Sub Rank() 
Dim rowsCount As Integer "保存 表 的 最 大 行 数 
Dim i As Integer 一 次 循环 计数 变量 


获得 成 绩 输入 表 当 前 已 建立 数据 最 后 一 行 的 行 号 
rowsCount = Sheet3.Cells(Rows.Count, 1).End(xIUp).Row 


Application.ScreenUpdating = False 


' 对 A 到 M 列 ， 按 照 上 列 排序 ， 


Sheet3.Range("A1:M" & rowsCount).Sort Key1:=Range("L2"), Order1:= _ 


' 关 闭 屏 幕 刷 新 
顺序 为 降序 


xlDescending, Header:=xlGuess, OrderCustom:=1，_ 
MatchCase:=False, Orientation:=xITopToBottom，_ 
SortMethod:=xlPinYin, DataOption1:=xlSortNormal 


Sheet3.Cells(2, 13) = 1 


' 将 排 到 第 一 位 的 名 次 记 为 1 


Ah 


第 5 章 学 生成 绩 乱 加 系 统 二 人 


' 从 第 三 行 开始 ， 将 该 行 的 总 成 绩 与 上 一 行 的 总 成 绩 比 对 ， 如 果 相等 ， 则 将 其 名 次 设置 为 上 
一行 相同 名 次 ,否则 将 上 一 行 名 次 加 1 后 设置 为 当前 学 生 的 班级 名 次 
Fori= 3 To rowsCount 
lf Sheet3.Cells(i -1, 12) <> Sheet3.Cells(i, 12) Then 
Sheet3.Cells(i, 13) = Sheet3.Cells(i -1, 13) + 1 


Else 
Sheet3.Cells(i, 13) = Sheet3.Cells(i -1, 13) 
Endif 
Next 
Application.ScreenUpdating = True "恢复 屏幕 刷新 
End Sub 


以 下 是 保存 成 绩 表 按钮 的 详细 代码 解释 : 
Sub SaveDatal() 


Dim ws As Worksheet "用 于 指向 保存 的 成 绩 表 对 象 
Dim rowsCount As Integer ' 保 存 表 的 最 大 行 数 
With frmXSMD "显示 班级 年 级 获取 窗口 ， 并 初始 化 标题 
.Caption = "选择 班级 名 " 
.Show 
End With 
' 取 得 成 绩 输入 表 的 最 大 行 数 
rowsCount = Sheet3.Cells(Rows.Count, 1).End(xIUp).Row 
Application.ScreenUpdating = False "关闭 屏幕 刷新 
On Error Resume Next 
Set ws = Sheets("CJ-" & tempBJ) "取得 该 班级 的 成 绩 表 对 象 
If ws Is Nothing Then 检测 表 对 象 是 否 获取 成 功 
Set ws = ThisWorkbook.Sheets.Add ' 未 获取 成 功 时 ， 说 明 该 班级 成 绩 表 未 建立 
Else ' 此 时 新 增 一 个 表 对 象 
ws.Delete 获取 成 功 ， 说 明 原 来 已 保存 过 该 表 
Set ws = ThisWorkbook.Sheets.Add ' 删 除 该 表 ， 然 后 新 增 一 个 表 对 象 
End If 
ws.Name = "CJ-" & tempBJ 路 改 新 得 到 的 表 对 象 名 称 
' 从 成 绩 输 入 表 中 复制 数据 到 该 表 对 象 
Sheet3.Range("A1:M" & rowsCount).Copy ws.Range("A1:M" & rowsCount) 
ws.Columns.AutoFit "自动 调整 该 表 对 象 的 列 宽度 
Application.ScreenUpdating = True "开启 屏幕 刷新 
End Sub 


5.4.2 年 级 排名 模块 设计 


[a 


FE 级 排名 模块 用 于 产生 某 个 年 级 全 体 学 生 的 总 分 名 次 列表 ， 该 表 只 设计 了 保存 功能 。 如 
果 需 要 修改 该 年 级 的 总 分 名 次 列表 ， 首 先 需 要 修改 对 应 学 生 所 在 班级 的 班级 成 绩 表 ， 然 后 再 
重新 生成 该 年 级 的 总 分 名 次 列表 。 

用 户 在 首页 单 击 【年 级 排名 】 按 钮 后 ， 将 会 弹出 【年 级 选择 】 对 话 框 。 该 对 话 框 借用 了 
年 级 班级 选择 窗口 ， 用 户 在 这 里 选择 完 年 级 就 可 以 进入 排名 工作 。 然 后 程序 会 检测 当前 选择 
年 级 下 是 否 所 有 班级 的 班级 成 绩 表 已 经 建立 。 如 果 存 在 没有 建立 的 ， 将 提示 建立 对 应 班级 成 
绩 表 ; 如 果 所 有 班级 的 工作 表 已 经 建立 ， 程 序 自动 完成 排序 工作 ， 并 将 结果 以 表 列 形式 显示 
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出 来 。 该 表 的 界面 如 图 5-32 所 示 。 该 表 的 显示 结果 是 初 二 年 级 的 排名 ， 其 中 初 二 年 级 只 有 两 
个 班级 。 


L Ml 2 
地 诗 名 分 班次 年 绕 鲜 次 [下 
I 


器 
Ed 
9 
EE 


风光 次 交 所 号 马 所 加 名 对 导 


图 5-32 年 级 排名 表 界 面 


该 工作 表 相 关 代码 包括 两 个 过 程 ， 分 别 是 单 击 首页 中 【年 级 排名 】 按 钮 时 的 宏 过 程 、 表 中 
保存 排名 表 按 钮 宏 过 程 。 由 于 两 个 过 程 的 代码 都 比较 复杂 ， 这 里 逐个 介绍 两 过 程 的 功能 和 代码 。 
在 首页 单 击 【 年 级 排名 】 按 钮 后 ， 将 调用 菜单 跳 转 代码 模块 的 NJPM 过 程 。 该 过 程 完成 
询问 年 级 、 检 测 对 应 年 级 下 所 有 班级 的 成 绩 表 是 否 已 经 建立 以 及 计算 年 级 排名 工作 。 该 过 程 的 
执行 流程 在 前 面 已 经 有 了 文字 说 明 ， 这 里 给 出 该 过 程 的 流程 图 。 由 于 该 过 程 比 较 复杂 ， 将 分 为 
3 个 流程 图 加 以 说 明 〈 如 图 5-33~ 图 5-35 所 示 ) ， 后 面 两 个 流程 图 是 第 一 个 流程 图 步骤 之 一 。 


是 
一 一 第 行 班级 是 否 属 于 当前 年 级 ? 
是 


获取 该 班级 成 绩 工作 表 对 和 象 ws 


ws 对 象 是 否 存在 ? 


从 各 班级 复制 成 绩 数据 到 年 级 排名 表 
对 年 级 排名 表 中 的 所 有 数据 排序 


设置 学 生 名 次 


5-33 ”年 级 排名 过 程 流程 图 


是 


3 


图 5-34 ”从 各 班级 复制 成 绩 数据 到 年 级 排名 表 流 程 图 
获取 年 级 排名 表 末 条 数据 行 的 行 号 owsCount 


对 年 级 排名 表 总 分 列 按 降 序 排序 


指定 第 一 个 学 生 的 名 次 为 1 


图 5-35 ”排序 并 设置 名 次 流程 图 
以 下 是 该 宏 过 程 的 详细 代码 解释 : 


国 办 公 应 用 非 啼 之 能 


Sub NJPM() 
Dim tablesCount As Integer 
Dim rowsCount As Integer, i As Integer, 
Dim strMsg As String 
Dim totalBJ As String 
Dim rowNumber As Integer 
Dim ws As Worksheet 
frmXSMD.Show 
tablesCount = Sheet6.Cells(Rows.Count, 2).End(xlUp).Row ”' 获 取 年 级 班级 表 班 级 列 末 条 的 行 号 
Fori= 2 To tablesCount "循环 年 级 班级 表 中 所 有 班级 列 单元 格 
ffLeft(Sheet6.Cells(i, 2), Len(tempNJ)) = tempNJ Then ”' 检 测 该 班级 是 否 属于 当前 年 级 
On Error Resume Next 


Set ws = Sheets("CJ-" & Sheet6.Cells(i, 2)) "获取 该 班级 的 工作 表 对 象 
If Err.Number Then 
MsgBox "班级 : <" & Sheet6.Cells(i, 2) & "> 的 成 绩 表 没有 建立 ! " vbOKOnly 
Exit Sub 
End If 
Err.Clear "清除 所 有 错误 记录 
End If 
Next 
Application.ScreenUpdating = False 
rowNumber = 2 "复制 数据 起 始 行 号 
Fori= 2 TotablesCount "循环 年 级 班级 表 中 所 有 班级 列 单元 格 
lf Left(Sheet6.Cells(i, 2), Len(tempNJ)) = tempNJ Then ”' 检 测 该 班级 是 否 属于 当前 年 级 
Set ws = Sheets("CJ-" & Sheet6.Cells(i, 2)) 获取 该 班级 的 成 绩 工 作 表 对 象 
rowsCount = ws.Cells(Rows.Count, 1).End(xIUp).Row "获取 班级 成 绩 工作 表 未 条 数据 行 
的 行 号 
ws.Range("A2:M" & rowsCount).Copy Sheet4.Range("A" & rowNumber) “复制 成 绩 数据 
rowNumber = rowNumber + rowsCount -1 "设置 下 一 次 复制 到 年 级 排名 表 的 位 置 
End If 
Next 
Sheet4.Activate "激活 年 级 排名 表 


rowsCount = Sheet4.Cells(Rows.Count, 1).End(xIUp).Row ”' 获 取 年 级 排名 表示 条 数据 行 的 行 号 

Sheet4.Range("A1:N" & rowsCount).Sort Key1:=Range("L2"), Order1:=xlDescending, Header:= _ 
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xITopToBottom，_ 
SortMethod:=xlPinYin, DataOption1:=xlSortNormal ”' 对 总 分 列 按 降序 排序 


Sheet4.Cells(2, 14) = 1 ' 指 定 第 一 个 学 生 的 名 次 为 1 
Fori= 3 To rowsCount "循环 年 级 排名 表 所 有 学 生 记录 行 
If Sheet4.Cells(i -1, 12) <> Sheet4.Cells(i, 12) Then ' 检 测 i 行 学 生 总 分 与 -1 行 总 分 是 否 相等 
Sheet4.Cells(i, 14) = Sheet4.Cells(i -1, 14) + 1 "设置 i 行 学 生 名 次 为 -1 行 名 次 加 1 
Else 
Sheet4.Cells(i, 14) = Sheet4.Cells(i -1, 14) ' 设 置 i 行 学 生 名 次 等 于 i 行 名 次 
End If 
Next 
Application.ScreenUpdating = True 
End Sub 


在 年 级 排名 表 中 包含 了 一 个 【保存 排名 表 】 按 钮 。 单 击 该 按钮 时 ， 将 弹出 一 个 对 话 框 (如 
图 5-36 所 示 ) 。 该 对 话 框 用 于 设置 保存 年 级 排名 表 的 名 称 。 当 用 户 在 【选择 年 级 】 复 合 框 中 
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选择 了 相应 年 级 后 ， 程 序 将 把 年 级 排名 表 保 存 为 以 “PM-” 开 头 ， 后 接 年 级 为 名 称 的 新 工作 表 
(如 图 5-37 所 示 ) 。 


本 7 
| 过 204 条 角 
11 | 21038 蒙 给 是 
加 区 吕 人 和 80 70 70 80 85 95 
14 0m 和 和 9 9 77 718 87 a 
15|2 7 
至 | 加 | tt 
图 5-36 保存 年 级 排名 表 设 置 图 5-37 保存 年 级 排名 
该 按钮 在 执行 宏 时 调用 功能 表 模块 中 的 SaveTotalData 过 程 ， 该 过 程 的 流程 图 如 图 5-38 
所 示 。 


获取 年 级 排名 表 末 行 数据 行 号 rowsCount 
获取 年 级 排名 工作 表 对 象 


删除 年 级 排名 工作 表 


图 5-38 保存 年 级 排名 表 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 


Sub SaveTotalData() 
Dim ws As Worksheet, rowsCount As Integer 


With frmXSMD 
.Caption = "选择 年 级 名 " ' 设 置 窗 体 显示 标签 
.Show ' 显 示 窗 体 
End With 
rowsCount = Sheet4.Cells(Rows.Count, 1).End(xIUp).Row 获取 年 级 排名 表 未 行 数据 行 号 


Application.ScreenUpdating = False 
On Error Resume Next 


Set ws = Sheets("PM-" & tempNJ) 获取 年 级 排名 工作 表 对 象 
If ws Is Nothing Then 检测 ws 工作 表 对 象 是 否 存在 
Set ws = ThisWorkbook.Sheets.Add "添加 新 工作 表 
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Else 

ws.Delete "删除 ws 工作 表 

Set ws = ThisWorkbook.Sheets.Add ' 添 加 新 工作 表 
End If 
ws.Name = "PM-" & tempNJ "设置 年 级 排名 工作 表 的 名 称 
Sheet4.Range("A1:N" & rowsCount).Copy ws.Range("A1:N" & rowsCount) “复制 年 级 排名 数据 
ws.Columns.AutoFit “年 级 排名 表 各 列 自动 对 齐 
Application.ScreenUpdating = True 
End Sub 


5.4.3 成绩 再 处 理 模块 设计 


成 绩 再 处 理 模块 用 于 修改 已 保存 好 的 班级 成 绩 工作 表 。 在 已 经 保存 的 班级 成 绩 工 作 表 中 ， 
并 没有 重新 计算 总 分 、 计 算 班 级 名 次 等 功能 按钮 。 为 了 能 够 在 完成 编辑 班级 成 绩 表 的 同时 ， 
完成 重新 计算 总 分 以 及 名 次 等 工作 ， 需 要 将 班级 成 绩 工 作 表 的 数据 导入 到 成 绩 输 入 表 中 完成 
班级 成 绩 再 处 理工 作 。 成 绩 再 处 理 模块 正 是 完成 该 部 分 工作 。 

在 首页 单 击 【成 绩 再 处 理 】 按 钮 后 程序 将 执行 菜单 跳 转 模块 中 的 CJZCL 过 程 。 程 序 首先 
以 无 模式 方式 显示 【成 绩 再 处 理 】 对 话 框 。 该 对 话 框 用 于 获取 需要 处 理 的 成 绩 表 的 名 称 。 获 
取 再 处 理 成 绩 表 名 称 后 ， 程 序 激活 了 成 绩 输入 表 。 激 活该 工作 表 后 ， 程 序 清除 了 工作 表 所 有 
数据 ， 然 后 从 再 处 理工 作 表 中 复制 所 有 数据 到 成 绩 输 入 表 中 。 该 过 程 的 代码 不 多 ， 这 里 不 再 
列 出 该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 详细 代码 解释 : 


Sub CJZCL() 

Dim rowsCount As Integer, ws As Worksheet 

frmCJZCL.Show ' 显 示 成 绩 再 处 理 表 选 择 窗口 
Sheet3.Activate ' 激 活 成 绩 输 入 表 

Set ws = Sheets(tempTableName) 获取 再 处 理工 作 表 对 象 

rowsCount = ws.Cells(Rows.Count, 1).End(xIUp).Row 将 取 成 绩 再 处 理工 作 表示 条 记录 行 号 
Application.ScreenUpdating = False 

Sheet3.Range("A2:M" & Rows.Count).ClearContents "清除 成 绩 输入 表 所 有 数据 


ws.Range("A2:M" & rowsCount).Copy Sheet3.Range("A2") “' 将 再 处 理工 作 表 数 据 复制 到 成 绩 输入 表 中 
Application.ScreenUpdating = True 
End Sub 


5.5 查询 模块 设计 


查询 模块 主要 完成 与 学 生成 绩 管理 相关 的 查询 工作 。 该 模块 可 以 分 为 班级 学 生 查询 、 教 
师 查询 和 班级 成 绩 查询 。 查 询 工作 的 实现 方法 都 采用 了 自动 筛选 的 方式 ， 而 筛选 条 件 通过 自 
定义 窗 体 获得 。 以 下 是 这 3 个 查询 模块 的 功能 介绍 。 
口 ”班级 学 生 查询 : 该 模块 主要 用 于 查询 学 生 信息 。 用 户 在 这 里 可 以 按 年 级 、 班 级 、 学 
号 、 姓 名 查询 学 生 情 况 。 
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口 教师 查询 :该 模块 可 以 查询 某 个 班级 的 具体 科目 的 任职 教师 。 

口 ”班级 成 绩 查 询 : 该 模块 可 以 按 班 级 、 按 学 生 号 或 按 学 生 名 查询 学 生成 绩 信息 。 

本 节 所 涉及 到 的 3 个 模块 的 代码 不 多 ， 所 有 的 功能 几乎 都 是 通过 窗 体 实现 的 。 关 于 窗 体 
的 设计 请 参见 后 面 窗 体 设计 章节 的 介绍 ， 介 绍 时 都 是 通过 实例 的 形式 加 以 说 明 。 


5.5.1 班级 学 生 查询 设计 在 首页 单 击 【 更 级 季 生 


查询 】 按 钮 


查询 窗 体 输 入 查询 资料 
自动 筛选 体现 查询 结果 


学 生 资料 包括 学 号 、 年 级 、 班 级 名 与 学 生 名 等 信息 。 
这 些 信息 都 是 预先 在 基本 资料 建立 模块 中 已 经 建立 的 资 
料 。 当 需要 查询 学 生 的 相关 资料 时 ， 可 以 通过 学 生 查询 模 
块 完成 该 工作 。 该 模块 的 操作 流程 如 图 5-39 所 示 。 

(1) 在 首页 单 击 【查询 】 分 类 栏 中 的 【班级 学 生 查 询 】 
按钮 。 此 时 将 执行 “菜单 跳 转 代码 ”模块 中 的 BJXSCX 过 
显 。 该 过 程 将 打开 【学 生 查 询 】 条 件 输入 窗口 ， 其 详细 代 
码 如 下 : 图 5-39 学生 查询 操作 流程 图 

Sub BJXSCX() 

frmXSCX.Show 

End Sub 

(2) 在 弹出 的 【学 生 查 询 】 条 件 设置 窗口 中 输入 学 号 、 年 级 、 班 级 和 学 生 名 查询 信息 。 
其 中 年 级 和 班级 信息 可 以 通过 下 拉 列 表 框 获取 ， 如 图 5-40 所 示 。 

(3) 在 【学 生 查 询 】 条 件 设置 窗口 中 输入 完 查询 信息 并 单 击 【 确 定 】 按 钮 。 此 时 将 会 跳 
转 到 “学 生 名 单 ”工作 表 ， 在 该 表 中 将 以 自动 筛选 的 形式 显示 查询 结果 。 如 果 需 要 修改 查询 
条 件 ， 可 以 单 击 自动 筛选 列 首 单元 格 右 下 方 的 下 拉 按 钮 并 重新 设置 筛选 条 件 ， 具 体操 作 见 本 
章 知 识 点 二 。 筛 选 后 的 效果 如 图 5-41 所 示 。 


[ETT Tr re 
& 3 & D E E 8 了 I 
学 号 辐 年 级 。 园 班 级 名 。 疗 学 生 名 辐 
二 年 级 初 二 年 级 1 班 周 孟 总 
21002 初 二 年 级 初 二 年 级 班 重 灵 芝 
21003 初 二 年 级 初 二 年 级 ] 班 和 章 西 


己 3 ”21012 初 二 年 级 初 二 年 全 1] 班 杨 昌 分 
| 二 年 级 初 二 年 级 ] 班 刘 振 亮 
15 。 21014 初 二 年 级 初 二 年 级 ] 班 重奏 阶 
Pe me 3 


图 5-40 学 生 信息 查询 条 件 输入 窗口 图 5-41 学 生 查 询 结 果 效 果 图 


5.5.2 教师 与 科目 查询 设计 


教师 资料 包括 教师 名 、 所 教 课程 名 以 及 对 应 班级 名 称 等 信息 。 这 些 信息 也 都 是 预先 在 基 


115 


办 公 应 用 非 啼 之 能 
Excel VBA 应 用 开发 经 典 案例 
本 资料 建立 模块 中 已 经 建立 的 资料 。 当 需要 查询 教师 的 相关 资料 时 ， 可 以 通过 教师 查询 模块 
完成 该 工作 。 操 作 流程 如 图 5-42 所 示 。 

(1) 在 首页 单 击 【 查 询 】 分 类 栏 中 的 【教师 查询 】 按 钮 。 此 时 将 执行 “菜单 跳 转 代码 ” 
模块 中 的 JSCX 过 程 。 该 过 程 将 打开 【教师 查询 】 条 件 输入 窗口 。 过 程 的 详细 代码 如 下 : 


Sub JSCX() 
frmJSCX.Show 
End Sub 


(2) 在 【教师 查询 】 条 件 设 置 窗口 中 输入 科目 名 和 班级 名 查询 信息 。 这 两 条 查询 信息 都 
可 以 通过 过 下 拉 列 表 框 获取 ， 该 窗口 的 界面 如 图 5-43 所 示 。 


在 首页 单 击 【 教 师 
查询 】 按 钮 


图 5-42 ”教师 与 科目 查询 流程 图 图 5-43 ”教师 信息 查询 条 件 输入 窗口 


(3) 在 【教师 查询 】 条 件 设置 窗口 中 输入 查询 信息 并 单 击 【确定 】 按 钮 。 此 时 将 会 跳 转 
到 “教师 资料 ”工作 表 并 在 该 表 中 以 自动 筛选 的 方式 显示 查询 结果 。 如 果 需 要 修改 查询 条 件 ， 
可 以 单 击 自动 筛选 下 拉 按 钮 并 重新 设置 筛选 条 件 。 筛 选 后 的 效果 如 图 5-44 所 示 。 


| 国光 和 -1 3 
i _ B C D E E [3 H I J E 上 有 
1 教师 名 国 班主 任国 语文 ” 国 数学 ” 国 英语 ”国政 治国 生物 加 急 理 加 化 学 加 历史 回 地理 加 全 玖 有 
2 开平 芳 
20 罗 肯 波 。 初 二 年 级 中 


25 让 油 建 七 年 级 1 班 
30 | 何 树 延 “ 九 年 级 4 班 
35 


538 


WT 首页] 轩 呈 沪 料 学生 大 闻 CJ- 初 二 年 红 0 志 关 畏 入 表 年 永 接 克 ， 症 毁 痊 尖 表 ] 


图 5-44 教师 资料 查询 结果 图 


5.5.3 ”班级 成 绩 查询 设计 


班级 成 绩 查 询 设 计 模 块 可 以 快速 定位 某 个 班级 或 某 个 班级 的 某 位 学 生 的 成 绩 信 息 。 在 查 
询 班级 或 学 生 的 成 绩 信息 之 前 需要 确保 该 班级 的 成 绩 表 已 经 建立 并 且 保 存在 工作 短 中 。 当 需 
要 查询 班级 或 班级 中 某 位 学 生 的 成 绩 信息 时 ， 可 以 通过 班级 成 绩 查 询 模块 完成 该 工作 。 该 模 
块 的 操作 过 程 如 图 5-45 所 示 。 

(1) 在 首页 单 击 【 查 询 】 分 类 栏 中 的 【班级 成 绩 查询 】 按 钮 。 此 时 将 执行 “菜单 跳 转 代 
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码 ” 模 块 中 的 CJCX 过 程 。 该 过 程 将 打开 【成 绩 查询 】 条 件 输入 窗口 。 该 过 程 详细 代码 如 下 : 


Sub CJCX() 
frmCJCX.Show 
End Sub 


(2) 在 【成 绩 查 询 】 条 件 设置 窗口 中 输入 班级 名 、 学 号 和 姓名 查询 信息 。 当 用 户 需 要 查 
询 某 班 级 所 有 学 生成 绩 时 ， 只 需要 输入 班级 名 即 可 。 当 需要 查询 某 学 生 的 成 绩 时 ， 学 号 和 姓 
名 两 个 信息 只 需要 输入 其 中 之 一 ， 程 序 会 自动 寻找 另 一 相应 信息 并 将 其 输出 到 相应 的 文本 框 。 
该 窗 体 界面 如 图 5-46 所 示 。 


在 首页 单 击 【 班 级 成 绩 
查询 】 按 钮 


图 5-45 ”班级 成 绩 查 询 流程 图 图 5-46 班级 成 绩 查 询 条 件 输入 窗口 


(3) 在 【成 绩 查询 】 窗 口中 输入 查询 信息 并 单 击 【确定 】 按 钮 。 此 时 将 会 跳 转 到 相应 班 
级 的 成 绩 工 作 表 中 并 以 自动 筛选 的 方式 显示 查询 结果 。 如 果 需 要 修改 查询 条 件 ， 可 以 单 击 自 
动 筛选 下 拉 按 钮 并 重新 设置 筛选 条 件 。 筛 选 后 的 效果 如 图 5-47 所 示 。 


| 国生 贡 于-1 


-ox 
| 人 B Gol Ds Ed Ro) GIRL 人 A 

1 | 学 号 回 姓 名 语文 数学 英语 政治 生物 物理 化 学 历史 地 理 总 分 班 名 次 
8 21008 草 兴 意 30 7 70 ?0 70 7 TO $4 "0 564 了 
5 

En 
59 

4》 [首页 .教师 资料 学生 名 单 | CJ- 初 二 年 纪 , 竺 ， 成 绩 簿 入 


图 5-47 ”班级 成 绩 查 询 结果 


5.6 窗 体 设计 


在 本 实例 中 一 共 使 用 了 5 个 窗 体 。 这 些 窗 体 分 别 在 各 个 工作 表 中 被 调用 。 部 分 窗 体 通过 
单 击 按钮 激发 ， 部 分 窗 体 通过 双击 工作 表 的 单元 格 实现 。 本 节 将 分 别 介绍 这 些 窗 体 的 界面 设 
计 过 程 与 代码 。 
5.6.1 ”成绩 查询 设置 窗口 设计 


当 用 户 在 首页 中 单 击 【班级 成 绩 查 询 】 按 钮 后 ，【 成 绩 查 询 】 对 话 框 将 会 弹出 。 窗 口中 
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包含 了 3 个 标签 控件 、1 个 复合 框 控件 、2 个 文本 框 控件 和 1 
个 按钮 。 如果 用 户 需 要 查看 整个 班级 的 成 绩 情况 ， 则 在 班级 名 me fri 
复合 杠 中 选择 相应 班级 即 可 。 需 要 注意 的 是 ， 当 需要 查询 班级 ee 


成 绩 时 ， 必 须 已 经 完成 班级 成 绩 输 入 工作 ， 否 则 班级 名 复合 
没有 任何 项 目 可 以 选择 。 该 窗口 的 界面 如 图 5-48 所 示 。 

建立 该 窗口 的 步骤 不 算 复杂 , 读者 可 以 按照 以 下 说 明 建立 
该 窗口 。 

(1) 在 Excel 2007 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 然 后 在 属性 窗 
口中 修改 新 建立 窗口 的 名 称 属性 为 fmCJCX， 如 图 5-49 所 示 。 

(2) 在 工具 箱 中 选择 标签 控件 。 然 后 在 frmCJCX 窗 体 中 连续 建立 3 个 标签 控件 。 最 后 通 
过 属性 窗口 将 这 3 个 标签 的 Caption 属性 分 别 修改 为 “班级 名 : ”、“ 学 号 : ”和 “姓名 : ”。 
各 个 标签 的 相对 位 置 如 图 5-49 所 示 。 

(3) 在 工具 箱 中 选择 复合 框 控件 。 然 后 在 窗口 的 “班级 名 ”标签 右 侧 插入 一 个 复合 框 控 
件 。 最 后 在 属性 窗口 中 将 该 复合 框 的 名 称 属性 修改 为 “cmb 班级 名 ”， 如 图 5-50 所 示 。 


图 5- 48 【成 绩 查 询 】 对 话 框 


图 5-49 插入 用 户 窗 体操 作 示意 图 图 5-50 ”班级 名 复合 框 名 称 设置 


(4) 在 工具 箱 中 选择 文本 框 控件 。 然 后 在 窗口 的 “学 号 ”和 “姓名 ”标签 右 侧 各 插入 一 
文本 框 控件 。 最 后 在 属性 窗口 中 修改 两 文本 框 控件 的 名 称 属性 分 别 为 “txt 学 号 ”和 “txt 姓 名”。 
(5) 在 工具 箱 中 选择 按钮 控件 。 然 后 在 窗口 的 底部 插入 一 按钮 控件 。 随 后 在 属性 窗口 中 
修改 该 按钮 的 Caption 属性 为 “确认 ”， 如 图 5-49 所 示 。 
成 绩 查 询 设置 窗 体 包含 了 5 个 事件 过 程 。 这 5 个 事件 过 程 分 别 是 窗口 初始 化 事件 、 班 级 
名 复合 框 改变 事件 、 姓 名 文本 框 改变 事件 、 学 号 文本 框 改变 事件 和 确定 按钮 单 击 事件 。 其 中 
班级 名 改变 事件 只 完成 学 号 与 姓名 文本 框 显 示 状 态 的 设置 工作 。 这 里 不 再 介绍 该 事件 的 功能 ， 
其 余 4 个 事件 的 功能 描述 如 下 : 
口 ”窗口 初始 化 事件 ， 窗口 初始 化 时 需要 为 班级 名 复合 框 添加 项 目 。 班 级 名 复合 框 中 的 
项 目 是 工作 竹中 所 有 成 绩 工 作 表 的 名 称 。 由 于 这 些 工作 表 的 名 称 都 带 有 “CJ-” 的 前 
级， 因而 在 添加 项 目 时 将 这 些 前 级 去 除 掉 了 。 
口 学 号 文本 框 改 变 事 件 ， 学 号 文本 框 发 生 改变 时 ， 需 要 将 当前 学 生 号 对 应 的 学 生 名 称 
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显示 在 姓名 文本 框 中 。 程序 使 用 Find 方法 定位 该 学 生 的 学 号 单元 格 , 然后 通过 offset 
方法 获取 该 学 号 学 生 的 姓名 。 

口 姓名 文本 框 改 变 事 件 ， 姓名 文本 框 发 生 改 变 时 ， 需 要 将 当前 姓名 学 生 的 学 号 显示 在 
学 号 文本 框 中 。 程 序 使 用 Find 方法 定位 该 学 生 的 姓名 单元 格 ， 然 后 通过 offset 方法 
获取 该 姓名 学 生 的 学 号 。 

口 ” 确 定 按钮 单 击 事件 : 单 击 【确定 】 按 钮 时 ， 程 序 首先 检测 用 户 是 否 输入 了 查询 条 件 。 
在 输入 了 必要 的 查询 设置 条 件 后 ， 程 序 将 激活 成 绩 工作 表 。 并 且 使 用 设置 的 查询 条 
件 ， 对 成 绩 工作 表 进 行 筛选 。 

以 下 是 这 几 个 事件 过 程 的 详细 代码 解释 : 


Private Sub UserForm_lnitialize() 


Dim ws As Worksheet 
With cmb 班级 名 
.Clear "清除 班级 名 复合 框 所 有 项 目 
For Each ws In ThisWorkbook.Worksheets "循环 工作 簿 中 所 有 工作 表 
If Left(ws.Name, 3) = "CJ-" Then ' 检 测 工作 表 是 否 是 成 绩 表 
.Addltem Right(ws.Name, Len(ws.Name) -3) 为 班级 名 复合 框 添加 新 项 目 
End If 
Next 
End With 


txt 学 号 .Enabled = False 
txt 姓名 .Enabled = False 
Set ws = Nothing 


End Sub 

Private Sub cmb 班级 名 _Change() 

txt 学 号 .Enabled = Len(cmb 班级 名 .Text) "设置 学 号 文本 框 的 可 用 状态 
txt 姓名 .Enabled = Len(cmb 班级 名 .Text) "设置 姓名 文本 框 的 可 用 状态 
End Sub 


Private Sub CommandButton1_Click() 


Dim ws As Worksheet 
lf Len(cmb 班级 名 .Text) Then ' 检 测 班级 名 复合 框 是 否 有 输入 结果 
Set ws = Worksheets("CJ-" & cmb 班级 名 .Text) "获取 成 绩 工作 表 对 象 
ws.Activate ' 激 活 成 绩 工作 表 
lf Len(txt 学 号 .Text) And Len(txt 姓名 .Text) Then "检测 用 户 是 否 输入 学 号 和 姓名 
ws.Range("A:A").AutoFilter field:=1, Criteria1:=txt 学 号 .Text "筛选 学 号 为 用 户 选 定 学 号 的 
学 生成 绩 行 
End If 
End If 
End Sub 
Private Sub txt 姓名 _Change() 
Dim ws As Worksheet, rg As Range 
Application.EnableEvents = False 
Set ws = Worksheets("CJ-" & cmb 班级 名 .Text) "获取 成 绩 工 作 表 对 象 
Set rg = ws.Range("B:B").Find(txt 姓名 .Text) "在 工作 表 B 列 查找 该 名 称 的 学 生 
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If Not rg ls Nothing Then 
txt 学 号 .Text = rg.Offset(0, -1) 
Else 
txt 学 号 .Text=" 
End 上 f 
Application.EnableEvents = True 
Set rg = Nothing 
Set ws = Nothing 
End Sub 


Private Sub txt 学 号 _Change() 
Dim ws As Worksheet, rg As Range 
Application.EnableEvents = False 
Set ws = Worksheets("CJ-" & cmb 班级 名 .Text) 
Set rg = ws.Range("A:A").Find(txt 学 号 .Text) 
If Not rg ls Nothing Then 
txt 姓名 .Text = rg.Offset(0, 1) 
Else 
txt 姓名 .Text = " 
End If 
Application.EnableEvents = True 
Set rg = Nothing 
Set ws = Nothing 
End Sub 


5.6.2 成 绩 再 处 理 设置 窗口 设计 


"检测 是 否 找到 该 名 称 的 学 生 单元 格 
"设置 学 号 文本 框 显示 数据 


' 清 空 学 号 文本 框 


' 获 取 成 绩 工作 表 对 象 

' 在 工作 表 的 A 列 查找 该 学 号 的 学 生 
' 检 测 是 否 找到 该 学 号 的 学 生 单元 格 
"设置 姓 名 文本 框 显示 数据 


' 清 空 姓 名 文本 框 


成 绩 再 处 理 窗口 用 于 选择 需要 重新 处 理 的 成 绩 工作 表 。 在 窗 体 中 仅 包 含 了 3 个 控件 ， 该 
[再 处 理 成 二 表 “= 


窗 体 的 界面 十 分 简洁 ,制作 也 十 分 简单 ， 这 里 不 再 列 出 
制作 该 窗 体 的 详细 制作 步骤 。 在 复合 框 中 包含 了 所 有 工 
作 适中 已 经 建立 了 成 绩 资 料 的 工作 表 的 名 称 。【 选 择 再 
处 理 成 绩 表 】 设 置 窗口 。 如 图 5-51 所 示 。 

窗口 中 包含 了 两 个 事件 过 程 : 窗口 初始 化 事件 过 


表 各 ;| 初 二 年 本 三 ”| 
确定 


图 5-51 【选择 再 处 理 成 绩 表 】 设 置 窗口 


程 、 确 定 按钮 单 击 事件 过 程 。 这 两 个 事件 过 程 的 详细 代码 解释 如 下 : 


Private Sub CommandButton1_Click() 
tempTableName = "CJ-" & combTableName.Text 
Unload Me 

End Sub 


Private Sub UserForm_lnitialize() 
Dim ws As Worksheet 
With combTableName 
.Clear 
For Each ws In ThisWorkbook.Worksheets 
If Left(ws.Name, 3) = "CJ-" Then 
.Addltem Right(ws.Name, Len(ws.Name) -3) 
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"保存 需要 重新 处 理 成 绩 工 作 表 的 名 称 
' 扼 载 窗 口 


' 清 除 复合 框 所 有 项 目 

"循环 工作 秒 中 所 有 工作 表 
"检测 工作 表 是 否 是 成 绩 工作 表 
为 复合 框 添加 新 项 目 
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End If 
Next 
End With 
End Sub 


5.6.3 教师 查询 窗口 设计 


教师 查询 窗口 用 于 设置 查询 教师 所 教授 的 科目 以 及 所 在 班级 。 这 两 个 查询 设置 将 被 应 用 
到 对 教师 资料 工作 表 的 查询 操作 中 。 该 窗 体 的 界面 如 图 5-52 所 示 ， 在 该 窗 体 中 用 户 不 能 单独 
选择 班级 名 。 
在 该 窗 体 中 包含 了 3 个 事件 过 程 ， 分 别 是 确定 按钮 单 击 事件 、 科 目 名 复合 框 改变 事件 和 
窗口 初始 化 事件 。 其 中 科目 名 复合 框 改变 事件 较为 简单 ， 只 是 用 于 设置 科目 名 复合 框 的 可 用 
状态 。 这 里 不 再 对 该 过 程 的 功能 加 以 详细 描述 。 以 下 是 剩余 两 个 事件 过 程 的 功能 介绍 。 
口 ”窗口 初始 化 事件 ， 窗 口 被 初始 化 时 ， 需 要 完成 两 件 事 情 。 分 别 是 为 科目 名 复合 框 和 
班级 名 复合 框 添加 项 目 、 设 置 班级 复合 框 的 可 用 性 。 科 目 名 复合 框 项 目 添加 十 分 简 
单 。 而 添加 班级 名 复合 框 项 目 时 ， 程 序 依次 循环 年 级 班级 表 中 班级 列 所 有 单元 格 。 
最 后 将 这 些 单元 格 的 内 容 添加 到 班级 名 复合 框 中 。 
口 ”确定 按钮 单 击 事件 ， 【确定 】 按 钮 用 于 将 用 户 设置 的 筛选 条 件 应 用 到 教师 资料 工作 
表 中 。 程 序 首先 逐个 比 对 用 户 设置 的 科目 名 称 ， 根 据 该 科目 名 称 确认 需要 往 选 的 列 
号 。 最 后 对 工作 表 进 行 筛选 时 ， 根 据 设置 的 班级 名 决定 最 终 的 筛选 方式 。 如 图 5-53 
所 示 显 示 了 该 事件 过 程 的 执行 流程 。 


根据 选择 科目 名 确定 筛选 列 列 号 columnCount 


筛选 出 columnCount 列 任教 班级 为 
用 户 设置 班级 所 有 记录 行 


筛选 出 columnCount 列 所 有 非 空 记录 行 


图 5-52 ”教师 查询 设置 窗口 图 5-53 【确定 】 按 钮 单 击 事件 过 程 流程 图 
该 窗 体 的 代码 如 下 : 


Private Sub UserForm_lnitialize() 
Dim rowsCount As Integer, i As Integer 


With combKM 
.Addltem "班主 任 " "添加 第 一 个 科目 名 项 目 
.Addltem "语文 " "添加 第 二 个 科目 名 项 目 
.Addltem "数学 " "添加 第 三 个 科目 名 项 目 


121 


TeP 


办 公 应 用 旨 党 之 荡 
Excel VBA 应 用 开发 经 典 案例 和 


.Addltem "英语 " 
.Addltem "政治 " 
.Addltem "生物 " 
.Addltem "物理 " 
.Addltem "化 学 " 
.Addltem "历史 " 
.Addltem "地 理 " 
End With 
rowsCount = Sheet6.Cells(Rows.Count, 2).End(xIUp).Row 


Fori= 2 To rowsCount 
combBJ.Addltem Sheet6.Cells(i, 2) 

Next 

combBJ.Enabled = False 

End Sub 


Private Sub btnOK_Click() 
Dim columnCount As Integer 
Sheet1.Activate 
Select Case combKM. Text 
Case ls = "班主 任 " 
columnCount = 2 
Case ls = "语文 " 
columnCount = 3 
Case ls = "数学 " 
columnCount = 4 
Case ls = "英语 " 
columnCount = 5 
Case ls = "政治 " 
columnCount = 6 
Case ls = "生物 " 
columnCount = 了 7 
Case ls = "物理 " 
columnCount = 8 
Case ls = "化 学 " 
columnCount = 9 
Case ls = "历史 " 
columnCount = 10 
Case ls = "地 理 " 
columnCount = 11 
End Select 
Application.ScreenUpdating = False 
With Columns("A:K") 
.AutoFilter 
上 Len(combBJ.Text) Then 


"添加 第 四 个 科目 名 项 目 
"添加 第 五 个 科目 名 项 目 
"添加 第 六 个 科目 名 项 目 
"添加 第 七 个 科目 名 项 目 
"添加 第 八 个 科目 名 项 目 
"添加 第 九 个 科目 名 项 目 
"添加 第 十 个 科目 名 项 目 


"获取 年 级 班级 工作 表 班 级 名 列 的 末 条 


数据 行 号 
"循环 班级 名 列 所 有 班级 
为 班级 名 添加 新 项 目 


"设置 班级 复合 框 不 可 用 


"激活 教师 资料 表 


' 检 测 科目 名 是 否 为 班主 任 
"设置 筛选 列 列 号 为 2 

' 检 测 科目 名 是 否 为 语文 
"设置 筛选 列 列 号 为 3 

' 检 测 科目 名 是 否 为 数学 
"设置 筛选 列 列 号 为 4 

' 检 测 科目 名 是 否 为 英语 
"设置 筛选 列 列 号 为 5 

' 检 测 科目 名 是 否 为 政治 
"设置 筛选 列 列 号 为 6 

' 检 测 科目 名 是 否 为 生物 
"设置 筛选 列 列 号 为 7 

' 检 测 科目 名 是 否 为 物理 
"设置 筛选 列 列 号 为 8 

' 检 测 科目 名 是 否 为 化 学 
"设置 筛选 列 列 号 为 9 

' 检 测 科目 名 是 否 为 历史 
"设置 筛选 列 列 号 为 10 

' 检 测 科目 名 是 否 为 地 理 
"设置 筛选 列 列 号 为 11 


"开启 自动 筛选 


' 检 测 用 户 是 否 设置 了 筛选 班级 


"筛选 出 columnCount 列 中 任教 班级 为 combBJ.text 的 所 有 教师 信息 


.AutoFilter Field:=columnCount Criteria1:="=*" & combBJ.Text & “", Operator:=xlAnd 


Else 
"筛选 出 columnCount 列 中 不 为 空 的 所 有 记录 行 
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.AutoFilter Field:=columnCount, Criteria1:="<>" 
End If 
End With 
Application.ScreenUpdating = True 
End Sub 


Private Sub combKM_Change() 
combBJ.Enabled = Len(combKM. Text) 
End Sub 


5.6.4 ”学 生 信 息 查询 窗口 设计 


学 生 信 息 查 询 窗 口中 要 设置 查询 学 生 信息 的 条 件 。 窗 口中 可 以 设置 的 查询 条 件 包含 学 号 、 
年 级 名 、 班 级 名 以 及 学 生 名 。 用 户 查 询 信息 时 ， 可 以 同时 设置 一 个 或 多 个 查询 条 件 。 该 窗口 
一 共 包含 了 4 个 标签 控件 、2 个 文本 框 控件 和 2 个 复合 框 控件 ， 其 界面 如 图 5-54 所 示 。 

建立 该 窗口 的 步骤 如 下 : 

(1) 在 Excel 2007 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 随 后 在 届 性 窗 
口中 修改 该 窗 体 的 名 称 属性 为 frmXSCX， 同 时 也 修改 其 Caption 属性 为 “学 生 查询 ”， 如 
图 5-55 所 示 。 


图 5-54 学 生 信息 查询 设置 窗口 图 5-55 ”学生 信息 查询 窗 体 属 性 设计 


(2) 在 工具 箱 中 选择 标签 控件 。 然 后 在 窗 体 中 连续 建立 4 个 标签 控件 。 最 后 将 这 4 个 标 
签 控件 的 Caption 属性 分 别 修改 为 “学 号 : ”、“ 年 级 : ”、“ 班 级 : ”和 “学 生 名 ”。 最 终 
各 个 标签 的 实际 效果 如 图 5-56 所 示 。 

(3) 在 工具 箱 中 选择 文本 框 控 件 。 然 后 在 “学 号 ”和 “学 生 名 ”标签 右 侧 各 插入 一 个 文 
本 框 控件 。 最 后 修改 这 两 个 文本 框 的 名 称 属性 分 别 为 txtXH 和 txtXSM。 

(4) 在 工具 箱 中 选择 复合 框 控件 。 然 后 在 窗 体 的 “年 级 ”和 “班级 ”标签 右 侧 各 插入 一 
个 复合 框 控件 。 最 后 在 属性 窗口 中 将 这 两 个 复合 框 控件 的 名 称 属性 分 别 修改 为 combNJ 和 
combBJ。 

(5) 在 工具 箱 中 选择 按钮 控件 。 然 后 在 窗 体 的 底部 插入 一 个 按钮 控件 。 然 后 在 属性 窗口 
中 修改 该 按钮 的 Caption 属性 为 “确定 ”。 

在 窗口 中 输入 了 合适 的 查询 条 件 并 单 击 【确定 】 按 钮 后 ， 程 序 将 自动 获取 这 些 查询 设置 
并 按照 该 设置 进行 查询 。 图 5-54 设置 的 查询 条 件 是 初 二 年 级 1 班 的 21006 号 学 生 信息 ， 该 项 
查询 设置 条 件 下 所 获得 的 查询 结果 如 图 5-57 所 示 。 


123 


办 公 应 用 匡 佛 之 狗 
Excel VBA 应 用 开发 经 典 案例 


加 学 生成 二 管理 系 较 -lan Efe 和 3| 
学 和 查询 


园子 二 且 二 站 二 
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] 学 号 国 年 级 ” 司 班 级 名 。 团 学 生 各 回 (Em 

LT | 21006 初 二 年 级 初 二 年 级 ] 班 蒙 要 
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2 首页 未 师资 料 】 学 二 名 外 CT- 裙 三 年 大 1 一- 袖 二 年 类 2 一 成绩 
图 5-56 标签 设计 效果 示意 图 图 5-57 学 生 信息 查询 结果 


在 该 窗口 中 一 共 包 含 了 3 个 事件 过 程 。 这 3 个 事件 过 程 分 别 是 窗口 初始 化 事件 过 程 、 年 
级 复合 框 改变 事件 过 程 和 确定 按钮 单 击 事件 过 程 。 其 中 只 有 年 级 复合 框 改 变 事 件 过 程 的 流程 
稍微 复杂 ， 下 面 的 介绍 中 只 给 出 该 过 程 的 流程 图 。 这 3 个 过 程 的 功能 介绍 如 下 : 
口 ”窗口 初始 化 事件 过 程 : 窗口 初始 化 时 ， 需 要 初始 化 一 些 公共 变量 。 这 些 变 量 将 用 于 
保存 用 户 在 设置 窗口 中 选择 查询 条 件 。 另 外 该 过 程 还 需要 完成 窗口 中 年 级 与 班级 复 
合 框 项 目的 添加 工作 。 
口 年 级 复合 框 改 变 事件 过 程 ， 当 用 户 改变 年 级 复合 框 中 的 选择 项 目 时 ， 程 序 需要 根据 
新 的 年 级 信息 确认 班级 复合 框 中 应 该 显示 的 可 选项 目 。 首 先 程序 将 班级 复合 框 中 所 
有 项 目 清除 ， 然 后 程序 从 年 级 班级 工作 表 的 班级 名 列 中 获取 当前 选择 年 级 的 所 有 班 
级 , 最 后 将 这 些 班级 依次 作为 新 项 目 添加 到 班级 复合 框 中 。 该 过 程 的 流程 图 如 图 5-58 
所 示 。 


清除 班级 复合 框 所 有 项 目 
获取 年 级 班级 工作 表 班 级 列 末 条 记录 行 号 rowsCount 


是 
丽 玉 级 是 于 属于 移 择 年级 到 
更 琢 复 售 杠 添加 该 丽 


放 i+1 


图 5-58 年 级 复合 框 改变 事件 过 程 流程 图 
口 ”确定 按钮 单 击 事件 过 程 : 单 击 【确定 】 按 钮 时 ， 程 序 将 把 用 户 选择 的 筛选 设置 条 件 
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保存 到 公共 变量 中 。 
以 下 是 该 窗 体 3 个 事件 过 程 的 详细 代码 解释 : 
窗口 初始 化 代码 


Private Sub UserForm_lnitialize() 
Dim rowsCount As Integer, i As Integer 


然后 根据 这 些 条件 分 别 完成 不 同 的 筛选 工作 。 


' 将 临时 存储 查询 条 件 的 各 个 变量 置 空 
tempXH ="" 置 空 学 号 公共 变量 
tempNJ = 置 空 年 级 公共 变量 
tempBJ = "" ' 置 空 班 级 公共 变量 
tempXSM = "" ' 置 空 学 生 名 公共 变量 
获取 年 级 列表 ， 并 将 其 添加 到 年 级 下 拉 列 表 框 中 
With combNJ 
.Clear "清除 年 级 复合 框 中 所 有 项 目 
rowsCount = Sheet6.Cells(Rows.Count 1).End(xIUp).Row "获取 年 级 班级 表 中 年 级 名 列 示 条 
数据 行 行 号 
Fori= 2 To rowsCount ' 循 环 年 级 名 列 所 有 数据 单元 格 
combNJ.Addltem Sheet6.Cells(i, 1) 为 年 级 名 复合 框 添加 新 项 目 
Next 
End With 
获取 所 有 班级 资料 列表 ， 并 将 其 列 入 班级 下 拉 列 表 框 中 
With combBJ 
.Clear ' 清 除 班级 名 复合 框 中 所 有 项 目 
rowsCount = Sheet6.Cells(Rows.Count 2).End(xIUp).Row "获取 年 级 班级 表 中 班级 名 列 未 条 
数据 行 行 号 
Fori= 2 To rowsCount "循环 班级 名 列 所 有 数据 单元 格 
combBJ.Addltem Sheet6.Cells(i, 2) 为 班级 名 复合 框 添加 新 项 目 
Next 
End With 
End Sub 
年 级 下 拉 列 表 框 改变 事件 
' 该 事件 用 于 检测 年 级 输入 是 否 改 变 ， 当 发 生 改变 时 ， 修 改 班级 下 拉 列 表 框 内 容 
Private Sub combNJ_Change() 
Dim rowsCount As Integer, i As Integer 
With combBJ 
.Clear "清空 班级 下 拉 列 表 框 项 目 
' 据 班级 年 纪 表 计算 班级 列 行 数 
rowsCount = Sheet6.Cells(Rows.Count, 2).End(xIUp).Row 
Fori= 2 To rowsCount "循环 检测 班级 年 纪 表 的 班级 列 


' 当 班级 的 名 称 对 应 了 当前 的 年 级 时 ， 将 该 班级 添加 到 班级 下 拉 列 表 框 的 项 目 中 
If combNJ.Text = Left(Sheet6.Cells(i, 2), Len(combNJ.Text)) Then 


combBJ.Addltem Sheet6.Cells(i, 2) 
End If 
Next 
End With 
End Sub 


' 按 钮 确定 单 击 事件 过 程 


为 班级 复合 框 添加 新 项 目 
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Private Sub btnOK_Click() 
' 将 查询 条 件 保存 到 相应 的 变量 中 
tempXH = txtXH.Text 
tempNJ = combNJ.Text 
tempBJ = combBJ.Text 
tempXSM = txtXSM.Text 
Sheet2.Activate 
Application.ScreenUpdating = False 
' 对 学 生 名 单 表 的 A 到 D 列 实施 自动 筛选 
With Columns("A:D") 
.AutoFilter 
IfLen(tempXH) Then 
.AutoFilter Field:=1, Criteria1:=tempXH 
End 上 
IfLen(tempNJ) Then 
.AutoFilter Field:=2, Criteria1:=tempNJ 
End 上 f 
IfLen(tempBJ) Then 
.AutoFilter Field:=3, Criteria1:=tempBJ 
End |f 
IfLen(tempXSM) Then 
"对 学 生 名 实施 自动 筛选 


' 保 存 学 号 查询 条 件 
' 保 存 年 级 查询 条 件 
' 保 存 班级 查询 条 件 
"保存 学 生 名 查询 条 件 
"激活 学 生 名 单 表 
"关闭 屏幕 刷新 


"开启 自动 筛选 
' 检 测 用 户 是 否 输入 了 学 号 
' 对 学 号 列 实施 自动 筛选 


' 检 测 用 户 是 否 输入 了 年 级 
"对 年 级 列 实施 自动 筛选 


' 检 测 用 户 是 否 输入 了 班级 
"对 班级 列 实施 自动 筛选 


' 检 测 用 户 是 否 输入 了 学 生 名 


.AutoFilter Field:=4, Criteria1:="=*" & tempXSM & "*", Operator:=xlAnd 


End If 
End With 
Application.ScreenUpdating = True 
End Sub 


5.6.5 ”年 级 班级 选择 窗口 设计 


在 本 实例 中 有 很 多 功能 都 需要 选择 年 级 与 班级 ， 程 序 通过 
-个 年 级 班级 选择 窗口 实现 了 该 功能 。 打 开 该 窗口 时 ， 会 随 着 到 
完成 事务 的 不 同 ， 窗 口 显 示 的 标题 也 会 有 所 差别 。 该 窗口 的 界 | 可 = 
面 如 图 5-59 所 示 。 在 该 窗口 中 共 包含 了 两 个 标签 控件 、 两 个 复 We Im 


合 框 控件 以 及 两 个 按钮 控件 。 


建立 该 窗口 步骤 比较 简单 ， 以 下 简 述 该 窗口 的 建立 过 程 : 
(1) 在 Excel 2007 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命令 ,随后 在 属性 窗 


' 重 新 打开 屏幕 刷新 


学 生 名 单 | 
选择 年 他 。 「 下 年 丽 | 


图 5-59 年 级 班级 获取 窗口 


口中 修改 该 窗 体 的 名 称 属性 为 fmXSMD， 如 图 5-60 所 示 。 
(2) 在 工具 箱 中 选择 标签 控件 。 随 后 在 窗 体 中 连续 建立 两 个 标签 控件 。 然 后 在 属性 窗口 


示意 图 如 图 5-61 所 示 。 


中 将 这 两 个 标签 的 Caption 属性 分 别 修改 为 “选择 年 级 : ”和 “选择 班级 : ”。 标 签 设计 效果 


(3) 在 工具 箱 中 选择 复合 框 控件 。 随 后 在 “选择 年 级 ”和 “选择 班级 ”标签 右 侧 各 插入 
一 个 复合 框 控件 。 然 后 在 属性 窗口 中 将 这 两 复合 框 控 件 的 名 称 属性 分 别 修改 为 combNJ 和 


combBJ。 
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图 5-60 学 生 名 单 窗 体 属性 设计 图 5-61 标签 设计 效果 示意 图 
(4) 在 工具 箱 中 选择 按钮 控件 。 随 后 在 窗 体 的 底部 连续 插入 两 个 按钮 控件 。 然 后 在 属性 


窗口 中 修改 这 两 个 按钮 控件 的 Caption 属性 分 别 为 “确定 ”和 “取消 ”。 

在 年 级 班级 选择 窗口 中 一 共 包 含 了 4 个 事件 过 程 代 码 。 这 4 个 事件 分 别 为 : 窗口 初始 化 
事件 、 年 级 复合 框 改变 事件 、 确 定 按钮 单 击 事件 和 取消 按钮 单 击 事件 。 其 中 取消 按钮 仅仅 完 
成 退出 窗口 的 工作 ， 下 面 只 对 前 3 个 事件 的 功能 加 以 详细 描述 。 

口 ”窗口 初始 化 事件 ， 当 窗口 第 一 次 加 载 时 ， 需 要 初始 化 年 级 复合 框 的 项 目 以 及 初始 化 
部 分 公共 变量 。 复 合 框 项 目的 数据 来 源 是 年 级 班级 工作 表 的 年 级 名 列 。 程 序 首先 获 
取 该 列 最 后 一 条 数据 的 行 号 ， 然 后 遍历 该 列 的 各 个 单元 格 ， 将 这 些 单元 格 的 数据 作 
为 新 项 目 添加 到 年 级 复合 框 中 。 图 5-62 是 该 事件 过 程 的 流程 图 。 

口 “年 级 复合 框 改变 事件 ， 当 用 户 在 窗口 的 年 级 复合 框 中 选择 了 某 个 年 级 或 更 改 了 该 项 
设置 时 ， 会 激发 年 级 复合 框 改 变 事件 。 该 事件 用 于 激活 班级 复合 框 的 可 用 状态 并 为 
该 复合 框 添加 选择 项 目 。 程 序 首先 将 班级 复合 框 设 置 为 可 用 ， 然 后 对 年 级 班级 工作 
表 的 班级 名 列 逐 行 检 测 。 当 检测 单元 格 的 班级 是 当前 年 级 时 ， 将 该 班级 名 作为 新 项 
目 添加 到 班级 复合 框 中 。 如 图 5-63 所 示 是 该 过 程 的 流程 图 。 


是 
-一 下 是 向 局 于 当 首 年 攻 一 二 
班级 复 侣 杠 添 加 新 项 目 加 


获取 年 级 班级 表 年 级 名 列 末 条 数据 行 号 rowsCount 


是 
年 级 复合 框 添加 新 项 目 


初始 化 班级 复合 框 可 用 状态 


初始 化 班级 公共 变量 tempBJ 
图 5-62 年 级 班级 窗口 初始 化 过 程 流程 图 图 5-63 年 级 复合 框 改变 事件 流程 图 
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办 公 应 用 齐 党 乞 笋 - 


人 ”Excel VBA 应 用 开发 经 典 案 例 。 于 于 ooo EE 


口 ”确定 按钮 单 击 事件 : 单 击 【确定 】 按 钮 时 ， 程 序 将 把 用 户 所 做 的 选择 设置 保存 到 公 
共 变 量 中 。 该 事件 的 代码 比较 简单 ， 这 里 不 再 列 出 该 过 程 的 流程 图 。 
以 下 是 年 级 班级 选择 窗口 的 详细 代码 解释 : 


Private Sub UserForm_lnitialize() ' 窗 口 初始 化 
Dim rowsCount As Integer "保存 表 的 最 大 行 数 
Dim i As Integer "循环 计数 变量 


Application.ScreenUpdating = False "关闭 屏幕 刷新 ， 以 防 屏幕 闪 动 
rowsCount = Sheet6.Cells(Rows.Count, 1).End(xIUp).Row 
"将 年 级 下 拉 列 表 框 按照 年 级 班级 表 中 的 年 级 列 填充 
Fori= 2 To rowsCount 
combNJ.Addltem Sheet6.Cells(i, 1) 


Next 

combBJ.Enabled = False ' 禁 止 班级 下 拉 列 表 框 的 可 用 性 
Application.ScreenUpdating = True "回复 屏幕 刷新 

tempBJ=" "将 公共 变量 置 空 

End Sub 

Private Sub combNJ_Change() "当年 级 下 拉 列 表 框 被 修改 后 执行 该 代码 
Dim rowsCount As Integer "保存 表 的 最 大 行 数 

Dim i As Integer "循环 计数 变量 

combBJ.Enabled = True "回复 班级 下 拉 列 表 框 的 可 用 性 


' 计 算 年 级 班级 表 中 班级 列 最 后 有 数据 的 单元 格 行 数 
rowsCount = Sheet6.Cells(Rows.Count, 2).End(xIUp).Row 
' 将 属于 当前 年 级 设置 下 的 班级 名 称 序列 写 入 班级 下 拉 列 表 框 的 序列 中 
With combBJ 
.Clear 
Fori= 2 To rowsCount 
If Left(Sheet6.Cells(i, 2), Len(combNJ.Text)) = combNJ.Text Then 
.Addltem Right(Sheet6.Cells(i, 2)，_ 
Len(Sheet6.Cells(i, 2)) -Len(combNJ.Text)) 
End If 
Next 
End With 
End Sub 


Private Sub btnOK_Click() 
' 如 果 在 班级 下 拉 列 表 框 选择 班级 ， 把 班级 信息 (包括 年 级 ) 保存 在 公共 变量 tempBJ 中 
"负责 仅 保存 年 级 到 公共 变量 tempNJ 
If Len(combBJ.Text) Then 
tempBJ =Trim(combNJ.Text ) & Trim(combBJ.Text) 
Else 
tempNJ =Trim(combNJ.Text) 
End 上 f 
Unload Me "卸载 窗 口 
End Sub 


Private Sub CommandButton1_Click() 
Unload Me 
End Sub 


_ 
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5.7 系统 测试 


本 部 分 系统 测试 以 生成 一 个 年 级 学 生成 绩 排名 为 目的 。 测 试 的 内 容 主 要 是 班级 成 绩 表 建 
立 与 年 级 排名 表 生 成 的 功能 。 该 项 测试 假设 初 二 年 级 只 有 两 个 班级 ， 并 且 学 生 名 单 工 作 表 中 
已 经 建立 了 两 个 班级 学 生 的 信息 。 以 下 将 分 两 个 小 节 分 别 测试 。 


5.7.1 建立 班级 成 绩 


要 产生 年 级 成 绩 排名 ， 首 先 需要 建立 该 年 级 下 所 有 班级 的 成 绩 。 系 统 根据 年 级 班级 表 中 
的 信息 来 确认 某 个 年 级 所 包含 的 班级 数目 ， 因 而 在 年 级 班级 表 中 务必 输入 完整 的 设置 信息 。 
以 下 是 建立 初 二 年 级 1 班 成 绩 的 步骤 : 

(1) 在 首页 单 击 【 成 绩 输入 】 按 钮 ， 在 随后 弹出 的 对 话 框 中 设置 年 级 与 班级 名 称 分 别 为 
“ 初 二 年 级 ”、“1 班 ”， 然 后 单 击 【确定 】 按 钮 ， 如 图 5-64 所 示 。 

(2) 设置 了 年 级 与 班级 名 称 后 ， 弹 出 成 绩 输入 表 工 作 表 。 在 该 表 中 输入 所 有 学 生 的 所 有 
科目 成 绩 即 可 ， 如 图 5-65 所 示 。 


| 镶 入 成 屁 班 级 的 年 级 与 班级 各 | 
碗 择 年 级 : 。「 初 二 年 - 


选择 班级 : 二 -| 


mw | mw | 


5-64 ”设置 年 级 与 班级 信息 5-65 初 二 年 级 1 班 学 生成 绩 


(3) 输入 完成 绩 后 ， 在 该 工作 表 中 依次 单 击 【 算 总 分 】 与 【计算 班级 名 次 】 按 钮 ， 此 时 
表 中 的 总 分 和 班 名 次 栏 将 自动 计算 获取 数据 ， 如 图 5-66 所 示 。 
(4) 计算 总 分 和 班级 名 次 完成 后 ， 单 击 【 保 存 成 绩 表 】 按 钮 。 在 随后 弹出 的 对 话 框 中 设 
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画 
选择 年 级; [| 局 


ww| ww | 


2 和 
本 


图 5-66 计算 总 分 和 班级 名 次 图 5-67 设置 保存 成 绩 表 所 属 年 级 与 班级 
5.7.2 ”生成 年 级 成 绩 排名 


由 于 初 二 年 级 有 两 个 班级 ， 在 生成 年 级 排名 前 ， 务 必 建 立 另 外 一 个 班级 的 成 绩 表 。 其 
步骤 与 上 面 建立 初 二 年 级 1 班 的 成 绩 表 类 似 ， 这 里 不 再 加 以 说 明 。 以 下 是 建立 年 级 排名 表 的 
步骤 ， 

(1) 在 首页 单 击 【 年 级 排名 】 按 钮 ， 在 随后 弹出 的 对 话 框 中 ， 设 置 年 级 为 “ 初 二 年 级 ”， 
单 击 【确定 】 按 钮 ， 如 图 5-68 所 示 。 

划 
WR | 


we | mm | 


图 5-68 设置 排名 年 级 所 属 年 级 


(2) 在 上 一 步 设置 了 年 级 并 确认 后 , 程序 自动 计算 该 年 级 所 有 班级 学 生 的 名 次 , 如 图 5-69 


所 示 。 当 需要 保存 该 名 次 表 时 ， 只 需要 单 击 【保存 排名 表 】 按 钮 ， 在 随后 弹出 的 窗口 中 设置 


a 
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2 | 21006 可 要 

] 2102s 真 交 地 
22050 何 驳 群 
21011 裹 务 桨 
21025 真实 山 
22054 韦 调 
21016 重 家 依 
21022 本 万 或 
21043 何 又 
21035 家 给 括 
21033 龙 建 东 
21009 罗 小 春 
22027 何 好 
5 | 22028 理 车 
21023 万 硬 航 
21020 重 罗 
22029 何 林 运 
21029 看 键 
21026 家 基 柱 
21017 何 所 
22030 何 产 向 
21052 重 过 诗 
21030 囊 方 如 
22008 要 傅 
21046 醒 伙 远 
21004 亚 急 可 
22005 陈 透 其 
23240354 析 习 春 
21053 任 祝 正 
21050 重信 
21041 何 宁 
21035 重信 入 
| 21018 龙 海 夺 
21043 圳 竺 三 
] 22022 王 敬 于 
| 22004 罗 训 项 
22045 相应 污 
22003 负 夺 由 
21010 罗 包 村 
和 | 22040 醒 交 清 
好 | 22001 生育 红 
本 | 21024 真 旅 业 
4 | 21021 


下 夸 主 


Lelolsle dsl llrl ny | © 
学 号 。 姓名。 语文 数学 半生 下 注 主 移 芍 于 化 学 万 突 二 于 名 分 下 名 次 千 撑 名次 攻关 
80 85 35 85 95 86 77 1 王 
30 85 95 55 35 1 1 
89 92 7 32 75 1 2 
380) 80 85 T7090 2 3 
80| 85| 95 70,93.5 3 4 
9 | 7 9 了 2 5 
80| 85) 95 70 89 4 E 
80 85 95 70 10 5 了 
80 70 80 30 5 了 
80 70 80 3 5 了 
80) 70) 80 70 5 了 
| 70 5 了 
3 93 7 73 7 3 昌 
89) 92 73 13 7 < 3 
0) ?0) 70 35 35 0 
| 70] 7 535 6 10 
7 73] 7: 5 
80 70 395 7t 95 70 7 了 
80) 70, 95 70 95) 7 了 
80, 80) 70 70 89.5) 7 D 
85| 90) 71 71) 69) 60 6 
80 70) 95 .70) 7 日 
80) 80 80 70) 70) 7 10 
74 56 83 73) 715) 54 了 
0 95 可 570] 7 于 
80 3 70 7 7 32 
?7 77 69 60 8 
80 35 0 70 7 
80 70 0 95) 7 
0 35 70 
70) 70) 7 
70) 70) 7 
70) 90) 7 
了 70 


加 避 吕 站 加 


图 5-70 设置 排名 表 保存 信息 
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第 6 章 固定 资产 管理 系统 


固定 资产 指使 用 期 限 较 长 ， 单 位 价值 较 高 ， 并 且 在 使 用 过 程 中 保持 原 有 实物 形态 的 资产 。 
固定 资产 管理 系统 是 一 个 企 事业 单位 不 可 缺少 的 部 分 。 它 的 内 容 对 于 企 事业 单位 的 决策 者 和 
管理 者 来 说 都 至 关 重 要 。 

根据 现行 行业 制度 规定 ， 企 业 使 用 了 一 年 以 上 的 房屋 、 建 筑 物 、 机 器 、 设 备 、 运 输 工 具 
等 资产 ， 均 应 作为 固定 资产 。 不 属于 生产 经 营 主要 设备 的 物品 ， 单 位 价值 在 2000 元 以 上 ， 并 
且 使 用 期 限 超过 两 年 的 ， 也 应 作为 固定 资产 。 不 符合 上 述 条 件 的 劳动 资料 ， 企 业 应 作为 低 值 
易 耗 品 管理 和 核算 。 


6.1 系统 概述 


固定 资产 是 企业 的 重要 生产 资料 之 一 。 随 着 时 间 的 推移 ， 固 定 资产 会 被 逐渐 损耗 ， 其 价 
值 会 逐渐 减少 。 如 果 不 对 固定 资产 进行 折旧 管理 ， 将 会 虚 增 企业 资产 ， 同 时 也 虚 增 了 企业 利 
润 ， 更 严重 的 是 由 此 也 导致 企业 上 交 的 所 得 税 的 增加 。 从 这 里 可 以 看 出 固定 资产 的 管理 的 重 
要 性 。 实 现 固 定 资产 的 电 算 化 可 以 极 大 地 减少 固定 资产 管理 工作 的 工作 量 ， 也 保证 了 该 项 工 
作 的 正确 率 。 


6.1.1 设计 思路 


本 系统 针对 功能 需求 ， 把 系统 功能 划分 为 4 个 部 分 : 系统 基本 设置 、 固 定 资产 登记 、 固 
定 资产 折旧 和 固定 资产 统计 分 析 。 该 系统 的 详细 结构 图 如 图 6-1 所 示 。 


固定 资产 详细 情况 查询 
单项 固定 资产 折旧 明细 查询 


资产 折旧 与 现 值 查询 
图 6-1 固定 资产 管理 系统 功能 结构 图 


溜 洪 尚 哈飞 品 筷 团 


_ 
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以 下 为 该 系统 4 个 功能 模块 的 详细 描述 。 
口 系统 基本 设置 。 该 功能 块 主要 针对 系统 进行 初始 设置 。 这 些 设置 包括 资产 编号 、 使 
用 部 门 、 资 产 类 别 、 资 产 来 源 。 这 些 信息 都 存储 在 对 应 的 设置 表 中 。 
口 固定 资产 登记 。 该 功能 块 主要 用 于 新 增 固定 资产 项 目 ， 并 且 设 置 该 固定 资产 的 所 有 
固定 属性 ， 其 中 有 些 属性 是 必 填 项 目 。 
口 固定 资产 折旧 。 该 功能 块 主要 针对 各 个 固定 资产 项 目 ， 生 成 固定 资产 折旧 。 折 旧 的 
计算 结果 都 保存 在 资产 项 目的 明细 表 中 。 
口 固定 资产 统计 分 析 。 该 功能 块 主要 用 于 统计 各 个 固定 资产 的 信息 ， 以 便于 查询 。 该 
部 分 包括 所 有 固定 资产 详细 情况 查询 、 单 项 固定 资产 折旧 明细 查询 、 资 产 折旧 与 现 
值 查 询 3 个 部 分 。 
固定 资产 进行 折旧 时 ， 方 法 很 多 ， 例 如 平均 年 限 法 、 工 作 量 法 、 双 倍 余额 递减 法 、 年 数 
总 和 法 等 。 本 例 计算 折旧 的 方法 是 平均 年 限 法 ， 其 计算 公式 如 下 : 
年 折旧 率 =(1- 净 残 值 率 )/ 使 用 年 限 
月 折旧 率 = 年 折旧 率 /12 
月 折旧 额 = 固定 资产 原 值 x 月 折旧 率 
该 系统 共 包 含 了 6 个 工作 表 ， 这 些 表 按 是 否 有 功能 代码 可 以 分 为 无 代码 基础 表 和 有 代码 
功能 表 两 类 。 代 码 基础 表 包括 首页 、 单 项 固定 资产 折旧 明细 模板 、 设 置 表 。 有 代码 功能 表 包 
括 固定 资产 登记 表 、 固 定 资产 登记 统计 、 固 定 资产 折旧 与 现 值 统计 。 各 表 的 详细 功能 解释 
如 下 
口 首页 用 来 显示 系统 所 有 功能 和 快速 在 各 个 功能 间 跳 转 。 
口 单项 固定 资产 折旧 明细 模板 该 表 是 单项 固定 资产 折旧 明细 表 的 格式 范本 。 单 项 固 
定 资产 折旧 明细 表 是 通过 复制 该 表 然后 向 其 中 填 入 需要 信息 完成 的 。 
设置 表 : 存储 系统 的 一 些 基本 设置 信息 。 
固定 资产 登记 表 : 该 表 完 成 固定 资产 登记 与 保存 工作 。 
固定 资产 登记 统计 : 该 表 显 示 所 有 已 登记 的 固定 资产 的 详细 信息 列表 。 在 其 中 双击 
某 个 固定 资产 行 时 ， 会 跳 转 到 该 固定 资产 的 详细 折旧 明细 表 。 
口 固定 资产 折旧 与 现 值 统计 : 实时 根据 所 有 已 有 的 固定 资产 详细 折旧 明细 表 产 生 固定 
资产 折旧 与 现 值 报告 。 


6.1.2 ”知识 点 一 : 设置 单元 格 条 件 格式 


DO 


条 件 格式 有 助 于 突出 显示 所 关注 的 单元 格 或 单元 格 区 域 、 强 调 异常 值 ， 还 可 以 使 用 数据 
条 、 色 阶 和 图 标 集 来 直观 地 显示 数据 。 条 件 格式 基于 用 户 条 件 设置 自动 更 改 单元 格 区 域 的 外 
观 。 如 果 条 件 为 真 (True) ， 则 该 单元 格 的 条 件 格式 设置 就 会 生效 ， 如果 条 件 为 假 (False) ， 
则 该 单元 格 的 条 件 设置 将 不 发 生 作用 ， 单 元 格 的 格式 恢复 到 原始 状态 。 手 动 新 建 条 件 格 式 设 
置 的 方式 如 下 : 

选择 表 中 的 一 个 或 多 个 单元 格 ， 在 【开始 】 选 项 卡 上 的 【样式 】 组 中 单 击 【 条 件 格式 】 


光世 


下 边 的 箭头 〈 如 图 6-2 所 示 ) ， 选 择 【新 建 规则 】 命 令 ， 弹 出 【新 建 格式 规则 】 窗 口 〈 如 
图 6-3 所 示 ) ， 在 该 窗口 中 设置 条 件 以 及 对 应 格式 即 可 。 


aE 
E13 
> 基于 各 目 值 设 寺 所 有 单元 格 的 格式 


> 也 对 排名 等 前 或 竺 后 的 数值 设 置 格式 


编辑 规则 说 明 下 ) 


只 为 满足 以 下 条 件 的 元 格 设 置 格式 ) 
RE 司 [于 | 国 到 |[ 国 
光 虹 预 客 未 设 定格 式 格式 四 
2 | 
图 6-2 条 件 格 式 按钮 组 图 6-3 ”新建 格式 规则 


6.1.3 ”知识 点 二 : SendKey 方法 


SendKey 方法 用 于 将 按键 信息 发 送 给 应 用 程序 , 通过 该 方法 可 以 模拟 按键 。 该 方法 的 使 用 
语法 如 下 : 

Application.SendKeys(Keys, Wait) 

其 中 Keys 参数 为 必 选 ， 该 参数 以 文本 形式 发 送 击 键 或 组 合 键 。Wait 参数 为 可 选 ， 如 果 为 
True， 则 程序 等 到 处 理 完 按键 后 返回 给 宏 ， 如 果 为 False (或 者 省 略 该 参数 ) ， 则 继续 运行 宏 
而 不 等 处 理 完 按键 。 以 下 的 实例 表示 按 Esc 键 : 

Application.SendKeys "{ESC}" 


6.2 首页 界面 设计 


首页 工作 表 属 于 无 代码 基础 表 ， 该 工作 表 的 设计 稍微 复杂 ， 所 以 单独 列 出 一 节 加 以 讲述 。 
首页 被 设计 用 来 显示 系统 所 有 功能 块 以 及 快速 在 各 个 功能 间 跳 转 。 在 本 系统 的 首页 上 可 以 通 
过 对 应 按钮 直接 访问 系统 的 各 个 功能 。 这 些 按钮 包括 固定 资产 登记 、 计 提 折 旧 、 基 本 设置 、 
查看 资产 登记 表 、 查 看 单项 资产 和 资产 折旧 与 现 值 。 在 各 个 子 功能 上 都 设计 有 相应 的 返回 按 
钮 。 这 些 按钮 共同 组 成 完整 的 跳 转 模 式 。 


6.2.1 首页 组 成 元 素 


本 系统 首页 构成 元 素 比较 简单 ， 共 包括 了 9 个 形状 和 3 个 横向 文本 框 。 其 中 9 个 形状 中 
又 分 1 个 矩形 形状 、2 个 对 角 圆 角 和 矩 形 和 6 个 棱 台 形状 。 各 个 形状 功能 如 下 : 
口 ”和 拢 形 形 状 。 首 页 界面 外 边框 ， 界 定 首 页 界面 的 范围 。 
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口 对 角 圆 角 和 矩形 。 划 分 功能 区 域 ， 在 对 应 的 该 形状 上 有 相应 的 文本 框 显示 该 区 域 的 
功能 。 

口 ” 棱 台 形状 。 被 设计 为 跳 转 按钮 。 

口 文本 框 。 包括 3 个 文本 框 ，1 个 是 首页 标题 ， 其 他 2 个 起 功能 提示 作用 。 

系统 首页 的 最 终 效 果 图 如 图 6-4 所 示 。 


由 ym 首页 ,国定 资产 析 肯 与 现 人 统计 国定 资产 村 记 统计 ， 国定 贡 产 区 记 表 。 吧 -1D00001- 尼 话 用 地 | 


图 6-4 固定 资产 管理 系统 首页 


6.2.2 首页 建立 步骤 


建立 该 界面 的 具体 步骤 如 下 : 

(1) 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】|【 和 矩形 】|【 和 矩形 】 命令 。 然 后 在 首页 
室 白 区 域 单 击 鼠 标 左 键 并 拖 动 产生 适当 大 小 的 矩形 ， 如 图 6-4 所 示 。 

(2) 右 击 刚 创 建 的 矩形 ， 在 弹出 的 快捷 菜单 中 选择 【设置 形状 格式 】 命 令 ， 打 开 【 设 置 
形状 格式 】 对 话 框 。 在 【设置 形状 格式 】 对 话 框 中 选择 【填充 】 项 并 在 其 右 侧 选中 【渐变 填 
充 】 单 选 按钮 ， 然 后 展开 【 预 设 颜色 】 下 拉 列 表 框 并 选择 “十 后 初 晴 ” 样 式 ， 如 图 6-5 所 示 。 
在 【类 型 】 下 拉 列 表 框 中 选择 “射线 ” 项目， 在 【方向 】 下 拉 列 表 框 中 选择 第 二 个 样式 “ 角 
度 辐 射 ”， 然 后 展开 【颜色 】 下 拉 列 表 框 并 选择 “深蓝 ” 色 ， 如 图 6-6 所 示 。 最 终 填 充 设 置 如 
图 6-7 所 示 。 


图 6-5 预 设 颜 色 样式 图 6-6 ”颜色 设置 
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(3) 在 【设置 形状 格式 】 对 话 框 中 选择 【线条 颜色 】 项 目 。 随 后 选中 【无 线条 】 单 选 
按钮 。 

(4) 在 【设置 形状 格式 】 对 话 框 中 选择 【阴影 】 项 目 。 随 后 在 其 右 侧 的 【 预 设 】 下 拉 列 
表 框 中 选择 【外 部 】 分 组 中 的 【居中 偏 移 】 项 目 。 

(5) 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】|【 和 矩形 】|【 对 角 圆 角 和 矩形】 命令 。 在 
以 上 创建 算 形 外 边框 的 内 部 单 击 鼠 标 左 键 并 拖 动 产生 一 适当 大 小 的 对 角 圆 角 和 矩形， 使 用 同样 
的 方法 在 矩形 外 边框 中 再 创建 一 个 对 角 圆 角 和 矩 形 。 然 后 分 别 右 击 两 对 角 圆 角 和 矩形 ， 在 弹出 的 
快捷 菜单 中 选择 【编辑 文字 】 命 令 ， 分 别 为 其 输入 文字 内 容 为 “资产 登记 ， 折 旧 与 设置 ”和 
“资产 查询 ”。 

(6) 分 别 右 击 刚 创建 的 两 对 角 圆 角 和 矩形 ， 在 弹出 的 快捷 菜单 中 选择 【设置 形状 格式 】 命 
令 ， 打 开 【 设 置 形状 格式 】 对 话 框 。 对 角 圆 角 矩 形 的 格式 设置 与 矩形 外 边框 较为 类 似 ， 不 同 
的 只 是 “方向 ”设置 。“ 资 产 登 记 、 折 旧 与 设置 ”形状 对 应 的 设置 为 第 四 种 角 部 辐射 。“ 资 
产 查 询 ” 形 状 对 应 的 设置 为 第 五 种 角 部 辐射 。 

(7) 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】|【 基 本 】|【 核 台 】 命 令 。 然 后 在 首页 
单 击 鼠 标 左 键 并 拖 动 以 产生 一 适当 大 小 的 棱 台 形状 。 其 格式 设置 与 前 面 各 种 形状 的 设置 类 似 ， 
这 里 不 再 资 述 。 

(8) 复制 以 上 创建 的 棱 台 形状 5 份 。 将 这 6 个 棱 台 中 前 3 个 依次 垂直 拖 动 到 “资产 登记 ， 
折旧 与 设置 ”形状 。 将 后 3 个 依次 垂直 拖 动 到 “资产 查询 ”形状 。 

(9) 依次 右 击 这 些 棱 台 形状 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 。 将 文字 内 容 
设置 为 对 应 按钮 的 提示 文本 。 随 后 再 次 右 击 这 些 形状 ， 在 弹出 的 快捷 菜单 中 选择 【指定 宏 】 
命令 ， 打 开 【 指 定 宏 】 对 话 框 ， 在 【指定 宏 】 对 话 框 的 【位 置 】 下 拉 列 表 框 中 选择 【当前 工 
作 短 】 选 项 ， 如 图 6-8 所 示 ， 然 后 在 宏 名 列表 中 选择 对 应 的 宏 即 可 。 


| 


填充 
线条 颜色 || c 无 填充 四 
钱 弄 个 师 色 填充 (8) 


阴影。 | 光 (@) 加 到 
人 图 片 或 赵 理 填充 下) 宅 各 如- 
ee 预 设 颜色 @) 上 国 己 [| 
图 片 类 型 中 CE l 录制 上 
文本 框 方向 四 ) rb 上 
一 [it 提 折旧 
We 7 
光 图 1 | 富 趟 加 BD) Ee 各 [ee 
结束 位 置 0): 中 一 一 区- 习 RE 司 
me 0: 下 到 ET Er | 
透明度) Di | < 
到 与 形状 一 起 旋转 四) 
| 
图 6-7 填充 设置 图 6-8 ”指定 宏 


首页 中 各 个 按钮 执行 宏 的 详细 列表 如 表 6-1 所 示 。 
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表 6-1 首页 按钮 执行 宏 列表 


按钮 标签 执行 宏 
固定 资产 登记 固定 资产 登记 
计 提 折旧 计 提 折旧 
基本 设置 基本 设置 
查看 资产 登记 表 固定 资产 统计 
查看 单项 资产 折旧 明细 表 
资产 折旧 与 现 值 折旧 与 现 值 统计 


6.3 ”其 他 无 代码 表 设 计 


除 首 页 外 ， 还 有 两 个 工作 表 也 是 无 代码 工作 表 ， 分 别 是 单项 固定 资产 折旧 明细 模板 工作 
表 、 设 置 表 工作 表 。 这 两 个 工作 表 的 界面 都 比较 简单 。 设 计 工作 没有 触及 形状 或 是 控件 ， 仅 
仅 是 填写 数据 和 调整 单元 格格 式 。 因 此 将 这 两 个 表 的 设计 合并 到 一 节 讲述 。 


6.3.1 单项 国定 资产 折旧 明细 模板 表 设计 


单项 固定 资产 折旧 明细 模板 工作 表 大 致 可 以 划分 为 两 个 部 分 ， 一 个 是 固定 资产 登记 信息 
区 ， 一 个 是 固定 资产 折旧 明细 账 区 ， 另 外 还 有 一 个 返回 按钮 。 该 表 的 界面 如 图 6-9 所 示 。 

在 固定 资产 登记 信息 区 中 ， 显 示 的 是 在 固定 资产 登记 时 获取 的 该 固定 资产 的 所 有 基本 信 
息 ， 其 中 年 折旧 率 、 年 折旧 额 、 残 值 、 月 折旧 率 、 月 折旧 额 是 公式 自动 产生 的 。 

在 固定 资产 折旧 明细 账 区 中 ,显示 的 是 该 固定 资产 进行 折旧 操作 时 可 能 涉及 到 的 各 个 项 目 。 
其 中 性 质 栏 是 用 于 提示 是 否 固 定 资产 折旧 计 提 完毕 。 当 固定 资产 折旧 计 提 完毕 后 , 该 栏 显示 “ 计 
是 完毕 ”， 否 则 不 显示 任何 信息 。 在 工作 表 中 只 显示 了 N 列 数据 ， 其 他 的 列 都 被 隐藏 了 。 


EEC -ox 
A B_L CD. 下 了 6 I I L 有 

1 EN 固定 责 产 登记 表 | 类别 生产 用 

3 资产 编号 资产 二 潭 页 用 年 限 : 年 计量 单 人 

和 | 许 产 名 和 灌 用 加 站 兆 殖 信和 系 : 完 

5 | 资产 内 格 制造 厂商 | 年 折旧 至 : 月 折旧 至 ， 

国资 产 从 介 六 有 6 其 [折旧 颜 : 月 折旧 客 元 

固定 责 产 分 类 账 | 性 质 


FE 更 UE EGR ，， 拆 四 
| 
@ 


净值 备 往 


定 资产 羡 记 考 。 取 TDI000;- 仓 许 用 地 。 取 -M6SB00001- 子 浊 电 脑 ， 取 -TD00002- 仿 硅 用 地 2 ， 音 巧 因 定 商 产 折 


图 6-9 固定 资产 折旧 明细 模板 界面 


6.3.2 ”设置 表 工 作 表 设计 


设置 表 用 于 存储 系统 在 运行 中 需要 用 到 的 一 些 基础 设置 信息 。 该 表 的 界面 如 图 6-10 所 示 。 
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这 些 信息 包括 资产 编号 数字 长 度 、 使 用 部 门 、 资 产 类 别 、 折 旧 日 期 、 资 产 来 源 。 以 下 是 这 些 
基础 设置 信息 的 详细 解释 : 


口 


口 


口 


资产 编号 数字 长 度 : 本 系统 中 对 于 固定 资产 的 资产 编号 采用 “资产 类 别 头 字 拼 音 + 数 
字 标 识 ” 的 方式 。 该 设置 就 是 设置 数字 标识 段 的 总 长 度 。 
使 用 部 门 : 存储 所 有 可 能 使 用 固定 资产 的 部 门 资 料 。 该 资料 在 固定 资产 登记 表 中 输 
入 时 可 以 使 用 ， 详 细 情 况 参见 6.4 节 。 
资产 类 别 : 和 使 用 部 门 的 意义 相似 ， 它 存储 可 能 的 固定 资产 分 类 。 在 固定 资产 登记 
表 中 输入 时 可 以 使 用 ， 详 细 情 况 参见 6.4 节 。 
折旧 日 期 : 该 日 期 为 最 后 一 次 进行 计 提 折旧 时 在 “frm 计 提 日 期 ” 窗 体 中 设置 的 折旧 
日 期 。 
资产 来 源 : 和 使 用 部 门 的 意义 相似 ， 它 存储 可 能 的 固定 资产 来 源 方式 。 在 固定 资产 
登记 表 中 输入 时 可 以 使 用 ， 详 细 情 况 参见 6.4 节 。 

[ 国 四 Earlkm -Ox 


A B C D | 
责 产 篇 号 教 字 长 朗 使 用 部 门 责 产 天 和 折旧 日 期 页 产 未 源 
5 总 经 理 主 土地 2007-4-5 网 入 
财务 部 自 建 


EPEFSepawwrocsh- 


记 W 二 三-100002- 蕊 席 用 地 2 单项 国定 资产 折旧 久 组 模板 二 国定 资产 登记 续 计 


图 6-10 设置 表 


6.4 ”固定 资产 登记 表 设计 


在 使 用 该 系统 进行 固定 资产 管理 时 ， 首 先 要 在 系统 中 建立 各 个 固定 资产 的 信息 ， 后 续 的 
所 有 操作 都 是 基于 这 些 已 建立 的 数据 而 进行 的 。 该 步骤 在 整个 管理 过 程 中 处 于 源头 ， 因 此 在 


此 需要 保证 数据 建立 的 正确 性 。 
6.4.1 表 界 面 设 计 


该 表 的 界面 如 图 6-11 所 示 ， 其 中 包含 了 3 个 棱 台 形状 按钮 ， 分 别 执行 返 


加 


、 利 用 数据 和 


保存 功能 。 这 3 个 按钮 的 具体 功能 描述 如 下 : 


口 
可 


口 


1 到 


【返回 】 按 钮 : 返回 到 首页 。 

【利用 数据 】 按 钮 : 利用 该 按钮 可 以 使 用 已 经 建立 的 固定 资产 数据 填充 该 登记 表 。 
如 果 需 建立 的 固定 资产 的 信息 与 已 建立 的 固定 资产 较为 相似 ， 可 以 通过 该 按钮 快速 
建立 。 需 要 注意 的 是 该 按钮 直接 填充 数据 中 还 包含 了 资产 编号 ， 因 为 资产 编号 不 能 
重复 ， 在 保存 前 需要 修改 该 资产 编号 。 

【保存 3 按钮 : 该 按钮 完成 两 个 工作 , 一 个 是 将 新 登记 的 固定 资产 信息 保存 到 以 MX-” 


wah 
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+ 资产 编号 + 资产 名 称 格 式 命名 的 工作 表 中 ， 另 外 它 还 将 会 将 这 些 信息 也 写 入 固定 资 


at 二 
产 登 记 表 中 。 
[ 国 ERrxkm ox 
[IE A Blc| Dp E 本 再 本 1 NE 
有 固定 责 产 登记 表 | 类 别 
2 
|! I 珊 用 军 也 : 评 计量 单位 
4 | 资产 名 称 使 用 部 门 : 阐 焉 和 值 率 :- 元 
5 | 资产 规格 孝 千 厂商 年 折旧 村 : 
站 | 朗 产 众人 地 用 日期 年 折旧 额 : 过 
了 
8 一 
EE | 


: 


H+ | 首页 国定 资产 沂 月 与 现 避 统计 ， 国定 资 产 芝 记 弹 计 ， 习 定 汇 产 富 忆 表 。 哎 -TD00001- 名 库 用 地 ， 双 -B65900001-[ | 周 
图 6-11 固定 资产 登记 表 界 面 


在 工作 表 中 有 一 部 分 单元 格 的 内 容 是 自动 生成 的 。 这 些 单元 格 是 年 折旧 率 (J5) 、 年 折旧 
额 (J6) 、 残 值 (L4) 、 月 折旧 率 (L5) 和 月 折旧 额 (L6) 5 个 单元 格 。 这 些 公式 的 基础 数据 
来 源 于 耐用 年 限 (J3) 和 净 残 值 率 (J4) 。 这 些 单元 格 的 公式 如 表 6-2 所 示 。 


表 6-2 单元 格 公式 列表 


单 元 格 公式 
年 折旧 率 (J5) =IF(J3>"",(1-J4)/J3,"" 
年 折旧 额 (J6) =IF(J3—>"",B6*J5,"" 
残 值 (L4) =B6*J4 
月 折旧 率 (L5) =IFU5<"".JS/12. 
月 折旧 额 (L6) =IF(L5>"".ROUND(B6*L5,2)," 


在 该 表 中 建立 固定 资产 信息 时 ， 可 以 通过 利用 数据 按钮 借用 已 建立 的 固定 资产 信息 。 还 
有 部 分 单元 格 的 数据 可 以 通过 双击 该 单元 格 获得 ， 这 些 单元 格 包 括 类 别 〈K1) 、 资 产 来 源 
(F3) 、 使 用 部 门 〈F4) 。 双 击 对 应 单元 格 后 程序 会 弹出 一 个 选择 信息 框 。 详 细 介绍 见 本 节 
的 代码 设计 。 


6.4.2 ”设置 单元 格 条 件 格式 


在 图 6-11 中 , 单元 格 显示 有 填充 颜色 的 均 设 置 了 条 件 格式 。 该 条 件 格式 的 目的 在 于 当 
这 些 单元 格 中 没有 输入 任何 数据 时 ， 对 填充 颜色 进行 修改 ， 以 起 到 提示 作用 。 设 置 的 方式 
如 下 

首先 在 固定 资产 登记 表 中 将 这 些 单 元 格 都 一 起 选中 。 然后 依次 选择 【开始 】 民 条 件 格式 】 
【新 建 规则 】 命 令 ， 弹 出 【新 建 格式 规则 】 对 话 框 ， 在 【选择 规则 类 型 】 列 表 框 中 选择 【只 
为 包含 以 下 内 容 的 单元 格 设置 格式 】 项 目 。 条 件 设置 为 【单元 格 值 ] 1【 等 于 】|【0】。 单 击 【 格 
式 】 按 钮 设置 填充 颜色 格式 后 确认 。 最 后 的 新 建 格式 规则 设置 如 图 6-12 所 示 。 
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新 建 格式 规则 本 (21x 


> 只 为 包含 以 下 内 容 的 单元 格 设置 格式 
* 避 对 排名 靠 前 或 过 后 的 数值 设置 格式 


所 可 规则 说明 是 
只 为 满足 以 下 条 件 的 单元 格 设 秆 格式 0) 
谨 形 司 [时 本 6 国 


天 微软 卓越 ”AaBbCe EFT 


图 6-12 新建 格式 规则 设置 


6.4.3 ” 表 初 始 化 代码 


在 固定 资产 登记 表 被 激活 时 ， 需 要 将 该 表 中 需要 填写 信息 的 单元 格 内 容 清除 ， 以 便 输入 
新 的 数据 。 本 实例 在 该 表 的 初始 化 事件 过 程 中 通过 一 个 “ 重 置 登 记 表 ”过 程 完成 该 项 工作 。 

在 该 过 程 中 ， 程 序 首先 通过 一 个 数组 保存 了 工作 表 中 部 分 单元 格 的 地 址 ， 然 后 通过 一 个 
循环 ， 遍 历数 组 各 个 元 素 ， 将 需要 进行 修改 的 单元 格 内 容 清 空 。 在 数组 保存 的 单元 格 中 ， 只 
有 一 部 分 单元 格 是 通过 公式 自动 产生 数据 的 ， 而 其 余 的 单元 格 都 不 需要 通过 代码 实现 数据 修 
改 , 比如 巧 、J6、L4 和 L5。 该 过 程 的 流程 图 如 图 6-13 所 示 。 


保存 单元 格 地 址 到 数组 myArray 


是 


一 否 
和 还 单元 格 不 含 公式 
置 空 第 i 个 单元 格 辆 


图 6-13 重 置 登记 表 过 程 流程 图 
以 下 是 该 工作 表 激 活 事件 代码 及 其 调用 的 过 程 的 详细 代码 解释 : 


Private Sub Worksheet Activate() 
重 置 登记 表 "清空 需要 填写 资料 的 单元 格 


End Sub 


Sub 重 置 登记 表 () 
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Dim myArray() As Variant, i As Integer 
"定义 单元 格 数组 ， 方 便 循环 清空 单元 格 内 容 
myArray = Array("K1", "B3", "B4", "B5", "B6", "F3", "F4", "F5", "F6", _ 
eA a oe oe ey ee py .sf Be ey) 
Fori= 0 To UBound(myArray) 
' 循 环 检测 各 个 单元 格 ， 当 不 是 自动 产生 数据 的 单元 格 时 ， 将 该 单元 格 内 容 设置 为 空 
If myArray(i) <> "J5" And myArray(i) <> "J6" And myArray(i) <> "L4" And myArray(i) <> _ 
"L5" And myArray(i) <> "L6" Then 
Range(myArray(i)) = Empty ' 置 空 单元 格 内 容 
End 上 
Next 
End Sub 


6.4.4 工作 表 双 击 事件 代码 


该 事件 过 程 用 于 打开 输入 辅助 提示 框 。 当 用 户 在 表 中 双击 时 ， 检 测 发 生 双 击 的 对 象 是 否 
需要 弹出 对 应 单元 格 的 输入 提示 框 。 表 中 单元 格 ， 包 括 类 别 (K1) 、 资 产 来 源 (F3) 、 使 用 
部 门 〈F4) 被 双击 时 ， 都 会 弹出 该 窗口 ， 而 弹出 的 窗口 显示 的 可 选 内 容 也 会 根据 不 同 的 情况 
发 生变 化 。 

当 确认 了 窗 体 需要 显示 的 项 目 类 型 后 ， 程 序 将 该 类 型 设置 情况 保存 到 公共 变量 “辅助 窗 
口 参数 ”中 。 打 开 输入 辅助 窗 体 后 ， 窗 体 将 根据 该 参数 确定 显示 项 目 类 型 。 用 户 在 窗 体 中 选 
择 了 项 目 后 ， 该 选择 项 目的 信息 仍然 被 存储 在 “辅助 窗口 参数 ”公共 变量 中 。 然 后 程序 将 该 
信息 填写 到 双击 单元 格 。 为 了 避免 双击 造成 的 单元 格 进入 编辑 状态 。 程 序 通过 SendKey 方法 
发 送 了 一 个 Esc 按键 动作 来 退出 单元 格 编辑 状态 。 

如 果 用 户 双击 类 别 单元 格 并 且 选 择 了 资产 类 别 项 目 后 ， 程 序 将 调用 获取 资产 编号 函数 ， 
该 函数 根据 用 户 的 选择 项 目 确定 当前 新 建立 资产 的 编号 。 

有 关 输 入 辅助 窗 体 的 设计 过 程 见 窗 体 设计 节 的 输入 辅助 窗 体 小 节 。 另 外 在 该 工作 表 的 双 
击 事件 过 程 中 ， 调 用 了 “获取 资产 编号 ”函数 ， 该 函数 的 介绍 请 见 公共 模块 节 。 以 下 是 双击 


事件 的 详细 代码 解释 : 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 

' 检 测 是 否 双 击 了 资产 类 别 输 入 单元 格 

If Target.Row = 1 And (Target.Column = 11 Or Target.Column = 12) Then 
辅助 窗口 参数 = "资产 类 别 " "该 公共 变量 在 输入 辅助 窗 体 中 将 会 调用 
frm 输入 辅助 .Show "显示 输入 辅助 窗口 , 窗口 被 关闭 时 会 修改 辅助 窗口 参数 
资产 登记 表 .Range("K1").Value = 辅助 窗口 参数 "获得 输入 的 资产 类 别 值 
Application.SendKeys "“{ESC}" ' 退 出 单元 格 的 编辑 状态 


' 当 获取 了 资产 类 别 时 ， 自 动产 生 资产 编号 ， 并 写 入 资产 编号 编辑 单元 格 中 
上 Len 人 (资产 登记 表 .Range("K1")) Then 
资产 登记 表 .Range("B3") = 获取 资产 编号 (资产 登记 表 .Range("K1")) 
End 上 f 
End If 
检测 是 否 双 击 了 资产 来 源 输入 单元 格 
If Target.Row = 3 And (Target.Column = 6 Or Target.Column = 7) Then 
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辅助 窗口 参数 = "资产 来 源 " 
frm 输入 辅助 .Show 
资产 登记 表 .Range("F4").Value = 辅助 窗口 参数 
Application.SendKeys (ESC}” 

End 上 f 

' 检 测 是 否 双 击 了 使 用 部 门 输入 单元 格 

IfTarget.Row =4And (Target.Column =6 OrTarget.Column =7) Then 
辅助 窗口 参数 = "使 用 部 门 " 
frm 输入 辅助 .Show 
资产 登记 表 .Range("F3").Value = 辅助 窗口 参数 
Application.SendKeys "{ESC}" 

End If 

End Sub 


6.4.5 固定 资产 保存 


当 在 固定 资产 登记 表 中 完成 了 某 个 固定 资产 的 信息 填 入 工作 后 ， 需 要 将 该 信息 填 入 相应 
的 固定 资产 折旧 明细 表 和 固定 资产 登记 统计 表 中 。 这 个 工作 由 “国定 资产 登记 保存 ”过 程 完 
成 。 当 单 击 按钮 保存 时 ， 该 过 程 被 执行 。 

在 固定 资产 登记 表 中 有 些 项 目 是 必 填 项 目 ， 包 括 资产 类 别 、 资 产 编号 、 资 产 名 称 、 资 产 
价值 、 使 用 部 门 、 始 用 时 间 、 使 用 年 限 。 该 过 程 首先 检查 这 些 项 目 是 否 为 空 ， 然 后 检查 资产 
前 号 是 否 有 重复 ， 最 后 保存 并 显示 保存 进度 。 该 过 程 的 详细 流程 图 如 图 6-14 所 示 。 


必 填 项 目 是 否 输入 数据 ? 


获取 资产 统计 表 末 条 数据 行 行 号 intRowsCount 


香 
第 i 行 资产 编号 与 当前 编号 不 一 样 ? 
是 


图 6-14 固定 资产 保存 过 程 流程 图 
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以 下 是 该 过 程 的 详细 代码 解释 : 


Sub 固定 资产 登记 保存 () 
Dim intRowsCount As Integer, i As Integer 
' 依 次 检查 各 个 必 填 项 目 ， 当 未 填写 内 容 时 ， 提 示 未 填写 项 目 信息 ， 然 后 终结 过 程 执行 
IfLen(Range("K1")) = 0 Then 
MsgBox "资产 类 别 不 能 为 空 ! " vbOKOnly + vblnformation "提示 资产 类 别 不 能 为 空 
Exit Sub 
Elself Len(Range("B3")) = 0 Then 
MsgBox "资产 编号 不 能 为 空 ! " vbOKOnly + vblnformation "提示 资产 编号 不 能 为 空 
Exit Sub 
Elself Len(Range("B4")) = 0 Then 
MsgBox "资产 名 称 不 能 为 空 ! " vbOKOnly + vblnformation "提示 资产 名 称 不 能 为 空 
Exit Sub 
Elself Len(Range("B6")) = 0 Then 
MsgBox "资产 价值 不 能 为 空 ! ", vbOKOnly + vblnformation "提示 资产 价值 不 能 为 空 
Exit Sub 
Elself Len(Range("F4")) = 0 Then 
MsgBox "使 用 部 门 不 能 为 空 ! ", vbOKOnly + vblnformation 得 示 使 用 部 门 不 能 为 空 
Exit Sub 
Elself Len(Range("F6")) = 0 Then 
MsgBox " 始 用 时 间 不 能 为 空 ! " vbOKOnly + vblnformation ' 竹 示 始 用 时 间 不 能 为 空 
Exit Sub 
Elself Len(Range("j3")) = 0 Then 
MsgBox "使 用 年 限 不 能 为 空 ! " vbOKOnly + vblnformation 提示 使 用 年 限 不 能 为 空 
Exit Sub 
End If 
' 检 查 资 产 编号 是 否 存 在 重复 项 目 
' 将 当前 的 资产 编号 与 资产 登记 统计 表 中 的 资产 编号 列 中 所 有 编号 比 对 , 当 找 到 有 一 致 时 , 提示 编号 重复 ， 
然后 退出 
intRowsCount = 资产 登记 统计 .Range("B" & Rows.Count).End(xIUp).Row 
Fori= 2 To intRowsCount 
If 资产 登记 统计 .Range("C" & i) = Range("B3") Then 
MsgBox "资产 编号 和 已 有 资产 冲突 ! ", vbOKOnly + vblnformation 
Exit Sub 
End If 
Next 
' 开 始 保存 工作 ， 并 显示 保存 进度 窗 体 
frm 进度 .Show 
End Sub 


6.5 国定 资产 登记 统计 表 设 计 


固定 资产 登记 统计 工作 表 用 于 存储 所 有 已 完成 登记 且 保 存 过 的 固定 资产 登记 信息 。 用 户 
也 可 以 通过 该 工作 表 打 开 对 应 固定 资产 的 详细 折旧 明细 表 ， 查 看 单条 的 固定 资产 信息 。 为 了 
便于 用 户 在 该 工作 表 中 浏览 固定 资产 的 详细 信息 ， 工 作 表 的 前 3 列 都 被 冻结 。 
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6.5.1 界面 设计 


固定 资产 登记 统计 工作 表 的 界面 设计 比较 简单 。 在 表 中 Al 单元 格 有 一 个 返回 按钮 ， 用 户 
通过 该 按钮 可 以 跳 转 回 首页 界面 。 固 定 资产 各 个 详细 信息 以 列表 的 形式 体现 出 来 。 在 该 表 中 
浏览 时 ， 为 了 保证 有 些 重要 信息 能 够 固定 下 来 ， 需 要 冻结 窗 格 。 

这 些 需 要 冻结 的 内 容 包 括 【 返 回 】 按 钮 列 、 资 产 类 别 列 、 资 产 编号 列 和 资产 名 称 列 。 操 
作 方 法 是 : 首先 选择 E2 单元 格 ， 然 后 依次 选择 【视图 】| 【冻结 窗口 】| 【冻结 拆 分 窗 格 】 命 
令 。 如 图 6-15 所 示 显 示 了 已 经 登记 了 两 个 固定 资产 后 的 固定 资产 登记 统计 表 。 


国 BE = 
[A 3 ce D E L 一 1 I Ek 
，， 通 国 加 剖 产 震 别 刺 产 名 二 商 产 名称 | 音 产 规格 瘟 产 价值 理 产 未 小 信用 部 门 制造 厂商 始 用 日 期 耐用 年 隧 洁 
| 土地 TDoo0ol re 300000 自 建 仓库 我 可 2006-4-10 30 
3 办 公设 备 B35B00001 BE 10000 购 入 站 经 理 室 2007-1-10 5 
4 运输 峰 材 ”Ysacoo001 轿车 | 取 域 纳 3000 100000 购 入 总 经 理 室 ”我 可 2007-4-10 20 
5 


4 | ， 取 -ESB00001- 手 是 电脑 ,JEK-YSQC00001- 轿 车 ， 单 项 国定 筑 产 折 I 忆 明细 模板 ， 轩 定语 产 基 记 法 i ， 国 定 寅 产 折 时 与 现 生 统 计 ， 设 置 表 [了] 

图 6-15 固定 资产 登记 统计 
在 该 工作 表 中 包含 的 固定 资产 信息 列 比较 多 。 用 户 可 能 在 该 模式 下 查看 单个 固定 资产 信 
息 时 感觉 不 习惯 ， 此 时 用 户 可 以 双击 固定 资产 信息 行 中 某 个 单元 格 ， 随 后 程序 会 自动 跳 转 到 
该 固定 资产 的 详细 情况 表 中 ， 如 图 6-16 所 示 。 该 图 显示 的 是 在 固定 资产 登记 统计 工作 表 中 双 
击 最 后 一 条 记录 时 的 显示 结果 。 此 时 再 单 击 其 中 的 【返回 】 按 钮 ， 将 会 跳 转 到 固定 资产 登记 


统计 工作 表 中 。 
IE ox 
上 L A meh aan onal. a 
固定 责 产 登记 表 | 类别 运输 器 村 
3 了 砍 产 玉 网 KX 珊 用 蒜 后 s+ 20 ”年 计 和 
在 | 资产 名 称 总 经 往 室 兆 殊 人 和 值 军 : 3 EE ;000 00 元 
5 | 微 产 观 楼 E34 J0 制造 厂商 : 贰 可 年 折 肯 率 :_ 47500 朋 术 IE 这 ; 0.3958. 
包 | 资产 价值 100, 000. 00 妨 用 日期 : ”2007-4-10 年 折 旧 额 ; 4Ts0.00 月 析 IE 新 : 395.83 元 
8 固定 责 产 分 类 账 | 性质 
9 “RE 区 EEC 下 py 
10| 期 各 量 单价 一 信 方 。 贫 方 余 大 和 8 全 方 贷方 | 要 计 扩 旧 新 净值 。 备注 
E24 T2007-4 "100.,000. 
11 rn 
13 
Pay 电 Ji=YSQc00001z=: 戎 国定 沉 产 扩 朋 明 雹 村 机 ， 国定 资 产 晤 统计， 国定 党 产 折 朋 上 


图 6-16 查看 详细 固定 资产 信息 
6.5.2 ”代码 设计 


在 该 工作 表 中 双击 标题 行 以 下 的 某 个 单元 格 时 ， 程 序 会 检测 当前 被 双击 单元 格 所 在 行 是 
否 有 固定 资产 记录 。 如 果 存 在 ， 将 会 打开 该 固定 资产 的 折旧 明细 表 ， 同 时 程序 还 设置 了 单 击 
【返回 】 按 钮 时 的 返回 位 置 ， 如 果 没 有 记录 数据 ， 则 不 执行 任何 操作 。 

在 该 过 程 中 用 到 了 “是 否 返 回 统计 表 ” 变 量 。 当 该 变量 被 设置 为 真 时 ， 单 击 【 返 回 】 按 
钮 将 返回 到 固定 资产 登记 统计 表 中 ， 和 否则 返回 到 首页 。 

以 下 是 该 工作 表 的 事件 过 程 的 详细 代码 解释 : 


互 
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Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Dim intRowsCount As Integer 

获取 资产 登记 统计 工作 表示 条 资产 所 在 行 号 

intRowsCount = 资产 登记 统计 .Range("B" & Rows.Count).End(xIUp).Row 


IfTarget.Row >= 2 And Target.Row <= intRowsCount Then "检测 被 双击 单元 格 所 在 行 是 否 有 
记录 数据 
是 否 返 回 统计 表 = True 设置 单 击 返 回 按钮 时 返回 位 置 
"激活 所 选 固定 资产 的 详细 信息 工作 表 
Sheets("MX-" & Range("C" & Target.Column) & "-" & Range("D" & Target.Column)).Select 
End If 
End Sub 


6.6 固定 资产 折旧 与 现 值 表 设计 


固定 资产 折旧 与 现 值 表 是 通过 一 个 表格 的 形式 完成 对 各 项 固定 资产 折旧 额 和 现 值 、 固 定 
资产 总 折旧 和 总 现 值 的 统计 工作 。 该 表 的 格式 被 隐藏 在 工 列 与 O 列 之 间 。 其 格式 包含 标题 、 
表 头 、 一 行 空 行 以 及 合计 行 《 如 图 6-17 所 示 ) 。 当 该 表 被 激活 时 ， 系 统 将 该 格式 复制 到 A 列 
到 G 列 。 然 后 循环 各 个 固定 资产 折旧 明细 表 ， 获 得 该 固定 资产 的 各 项 数据 后 插入 到 空 行 数据 
中 。 最 后 的 一 项 合计 行 对 所 有 项 目 数据 进行 汇总 。 


[ 国 EERralsn -oo 
L L E J 了 了 上 


00001- 训 库 用 二 ， 壮 -555900001- 手 要 电脑 “单项 因 十 闹 产 折 民 明 纪 区 板 ] 和 0 本 列 


图 6-17 固定 资产 折旧 与 现 值 统计 格式 


6.6.1 表 界 面 设计 


该 表 被 激活 后 的 显示 界面 比较 简洁 : 通过 按钮 可 以 返回 系统 首页 。 该 表 的 数据 项 目 是 通 
过 工作 表 的 激活 事件 实现 重新 计算 的 ， 即 每 次 该 表 被 激活 时 ， 该 表 都 会 重新 产生 一 次 。 当 数 
据 固定 资产 折旧 明细 表 发 生变 化 时 ， 其 统计 数据 可 以 通过 再 次 激活 该 表 得 到 刷新 。 该 表 最 终 
设计 完成 后 的 界面 如 图 6-18 所 示 。 

EEET -ox 


5 c 了 E 下 8 下 


国定 责 产 折旧 与 现 值 统计 EN 


ID 
卫 -TD00001- 仓 库 用 地 区 -Bc 多 0000;- 竹 提 电 脑 。 章 项 国定 资产 沂 表 且 细 模板 ， 全 证 资 产 莹 再现 | 天 


6-18 固定 资产 折旧 与 现 值 统计 表 
另外 该 表 从 HH 列 以 后 的 数据 都 被 隐藏 掉 。 在 该 表 的 I1 到 05 单元 格 区 域 中 保存 了 表 的 头 
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部 格式 。 每 次 工作 表 被 激活 时 ， 清 除 掉 表 中 显示 数据 后 ， 程 序 都 会 从 该 隐藏 


数据 与 格式 。 
6.6.2” 表 代码 设计 


该 表 的 代码 包含 在 两 个 事件 过 程 代 码 中 。 
一 个 是 表 被 激活 时 的 Worksheet Activate 事件 ， 
一 个 是 表 脱 离 激活 状态 的 Worksheet_Deactivate 
事件 。 这 两 个 事件 的 功能 描述 如 下 : 
口 ” 表 激活 事件 : 表 被 激活 时 的 Worksheet_ 
Activate 事件 用 于 重新 获取 数据 ， 形 
成 固定 资产 折旧 与 现 值 统计 数据 。 
口 表 失 去 激活 事件 ， 表 脱离 激活 状态 的 
Worksheet_Deactivate 事件 用 于 清除 
该 表 中 所 有 数据 。 这 些 数据 不 包括 单 
元 格 的 格式 设置 。 
这 两 个 事件 中 表 失 去 激活 事件 过 程 比 较 简 
单 ， 代 码 也 很 精简 ， 这 里 不 再 针对 该 事件 多 做 
说 明 。 以 下 重点 讲述 表 激 活 事件 过 程 的 流程 及 
其 流程 图 。 

当 工 作 表 被 激活 时 ， 程 序 首先 获取 了 资产 
记 统计 表 末 条 数据 的 行 号 。 然 后 根据 该 值 确 
是 否 有 固定 资产 记录 被 登记 。 当 确认 有 固定 
产 登记 时 ， 程 序 将 依次 插入 对 应 行 数 ， 以 统 
计 各 个 固定 资产 的 折旧 与 现 值 。 然 后 把 这 些 固 
定 资产 的 信息 依次 写 入 新 添加 的 行 中 。 最 后 程 
序 通 过 赋予 单元 格 计算 公式 完成 各 项 统计 工 
作 。 这些 工作 表 包 括 原 价 汇总 、 月 折旧 额 汇总 、 
折旧 总 额 汇总 和 净值 汇总 。 如 图 6-19 所 示 的 是 
该 事件 过 程 的 流程 。 

这 两 个 事件 的 详细 代码 解释 如 下 : 
Private Sub Worksheet_Activate() 


定 
资 


[ep | 


设置 起 始 插 入 新 行 行 号 intRowsCount=4 


获取 资产 登记 统计 第 i 行 固定 资产 的 明细 资 
产 登 记 表 对 象 ws 


获取 ws 工作 表 林 行 数 据 行 行 号 intRowsCount 
向 资产 折旧 与 现 值 统计 工作 表 填 写 数据 


计算 固定 资产 原价 汇总 
计算 固定 资产 月 折旧 额 汇 总 


计算 固定 资产 折旧 总 额 汇 总 


计算 固定 资产 净值 汇总 


图 6-19 国定 资产 折旧 与 现 值 统计 表 激活 事件 


过 程 流程 图 


Dim intRowsCount As Integer, i As Integer, intTemp As Integer 


Dim ws As Worksheet 


复制 11 到 05 区 域 的 单元 格 ， 粘 贴 到 A1 单元 格 ， 该 区 域 保存 的 是 表格 的 格式 


Range(Cells(1, 9), Cells(5, 15)).Copy Range("A1") 


获取 固定 资产 统计 表 的 有 数据 行 的 未 行 号 


intTemp = 资产 登记 统计 .Range("B" & Rows.Count).End(xIUp).Row 
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' 如 果 在 固定 资产 统计 表 中 有 国定 资产 记录 存在 , 即 有 数据 行 的 行 号 至 少 大 于 2 时 , 开始 填充 表 中 空 行 数 
据 区 
IfintTemp >= 2 Then 
intRowsCount = 4 
"以 下 循环 用 于 产生 足够 多 的 空 行 , 因为 首 行 空 行 已 经 存在 且 intTemp 记录 的 是 包括 固定 资产 统计 表 
标题 行 的 行 号 ,所 以 循环 变量 起 始 值 为 3， 终 值 为 intTemp 
Fori=3TointTemp 
' 在 最 后 总 计 行 单元 格 区 域 上 插入 一 行 空 行 数 据 ， 且 总 计 行 向 下 移动 一 行 
Range(Cells(intRowsCount, 1), Cells(intRowsCount, 7)).Insert shift:=xlShiftDown 
"保存 当前 总 几 行 的 行 号 
intRowsCount = intRowsCount+ 1 
Next 
"循环 各 个 固定 资产 折旧 明细 表 ， 获 取 相 应 数据 
Fori= 2 To intTemp 
' 通 过 固定 资产 登记 统计 表 中 的 记录 ， 获 取 表 名 ， 根 据 表 名 建立 各 个 固定 资产 折旧 明细 表 对 象 
Set ws = Worksheets("MX-”& 资产 登记 统计 .Range("C" & i) & "-" & 资产 登记 统 
计 .Range("D" & i)) 
' 获 取 当 前 固定 资产 折旧 明细 表 的 最 大 行 号 
intRowsCount = ws.Range("A" & Rows.Count).End(xIUp).Row 
' 根 据 固定 资产 折旧 明细 表 中 的 数据 填充 固定 资产 折旧 与 现 值 表 相应 的 栏 位 


With ws 
Range("A" & (i+ 2)) = .Range("B3") 资产 编号 
Range("B" & (i + 2)) = .Range("B4") 资产 名 称 
Range("C" & (i+ 2)) = .Range("B6") "原价 
Range("D" & (i+ 2)) = .Range("L5") 上 月 折 
Range("E" & (i + 2)) = .Range("L6") "上 月 折旧 额 
Range("F" & (i+ 2)) = .Range("K" & intRowsCount) 折旧 总 额 
Range("G" & (i+ 2)) = .Range("L" & intRowsCount) 净值 
End With 
Next 
"形成 汇总 行 数据 
intRowsCount = Range("A" & Rows.Count).End(xIUp).Row 获取 汇总 行 行 号 
"原价 汇总 
Range("C" & intRowsCount).Formula = "=sum(C4:C" & (intRowsCount -1) & ")" 
' 月 折旧 额 汇总 


Range("E" & intRowsCount).Formula = "=sum(E4:E" & (intRowsCount -1) & ")" 
"折旧 总 额 汇 总 
Range("F" & intRowsCount).Formula = "=sum(F4:F" & (intRowsCount -1) & ")" 
' 净 值 汇总 
Range("G" & intRowsCount).Formula = "=sum(G4:G" & (intRowsCount -1) & ")" 
Set ws = Nothing 

End If 

End Sub 


Private Sub Worksheet_Deactivate() 

Dim intRowsCount As Integer 

intRowsCount = Range("A" & Rows.Count).End(xIUp).Row 

"清除 A 列 到 G 列 的 有 数据 区 域 单元 格 

Range(Cells(1, 1), Cells(intRowsCount, 7)).Delete shift:=xlShiftUp 
End Sub 
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6.7 基本 设置 窗 体 设计 


基本 设置 窗 体 为 系统 提供 了 设置 系统 基本 信息 的 界面 。 对 于 该 系统 ， 在 运行 之 前 ， 需 要 
建立 其 相应 的 基本 信息 资料 ， 信 息 包括 资产 编号 、 使 用 部 门 、 资 产 类 别 、 资 产 来 源 。 这 些 资 
料 都 被 最 终 保 存在 设置 表 中 ， 以 便于 系统 其 他 功能 模块 调用 。 

由 于 该 窗 体 的 代码 比较 多 ， 在 介绍 窗 体 代码 设计 时 ， 笔 者 将 这 些 代码 进行 了 分 类 。 详 细 
情况 参见 本 节 的 后 续 小 节 内 容 。 


6.7.1 窗 体 界面 设计 


由 于 在 该 窗 体 中 需要 设计 的 内 容 繁 多 ， 因 此 采用 了 多 页 控件 ， 其 中 资产 编号 、 使 用 部 门 、 
资产 类 别 、 资 产 来 源 各 占用 一 个 页 。 表 6-3 列 出 了 该 窗 体 下 除 标 题 控 件 外 所 有 控件 的 控件 名 、 
所 属 页 控件 名 、 功 能 信息 。 
表 6-3 基本 设置 表 控 件 列表 
控 件 名 | 所 属 页 控件 名 控件 说 明 
文本 框 控件 。 完 成 显示 或 输入 操作 ,其 操作 的 对 象 是 设置 表 中 资产 编号 长 度 即 
A2 单元 格 
列表 框 控件 。 显 示 


数字 长 度 | 资产 编号 


部 门 列表 | 使 用 部 让 :设置 表 中 存在 的 所 有 部 门 


部 门 名 称 | 使 用 部 让 fi 在 部 门 列表 中 选择 的 部 门 或 输入 新 部 门 

部 门 添加 | 使 用 部 让 按钮 。 单 市 该 这 包 将 当前 部 ] 名 称 文本 框 中 的 部 门 添 加 到 设置 表 的 使 用 部 门 中 
部 门 修改 | 使 用 部 让 按钮 。 将 当前 在 部 门 列表 中 选择 的 部 门 修改 为 部 门 名 称 中 的 新 部 门 名 

部 门 删 除 _| 使 用 部 让 按钮 。 将 在 部 门 名 称 中 显示 的 部 门 删除 掉 


类 别 列表 | 资产 类 别 列表 框 控 件 。 显 :设置 表 中 存在 的 所 有 类 别 

类 别名 称 | 资产 类 别 文本 框 控 件 在 类 别 列表 中 选择 的 类 别 或 输入 新 类 别 

类 别 添加 _| 资产 类 刚 按钮 。 单 击 该 按钮 将 当前 类 别名 称 文本 框 中 的 类 别 添加 到 设置 表 的 使 用 类 别 中 
类 别 修改 | 资产 类 兄 按钮 。 将 当前 在 类 别 列表 中 选择 的 类 别 修改 为 类 别名 称 中 的 新 类 别名 

类 别 删除 | 资产 类 刚 按钮 。 将 在 类 别名 称 中 显示 的 类 别 删除 掉 

来 源 列表 | 资产 来 源 列表 框 控件 。 显 示 当 前 在 设置 表 中 存在 的 所 有 来 源 

来 源 名 称 | 资产 来 源 文本 框 控件 。 显 示 当 前 在 来 源 列表 中 选择 的 来 源 或 输入 新 来 源 

来 源 添加 | 资产 来 源 按钮 . 单 击 该 按钮 将 当前 来 源 名 称 文本 框 中 的 来 源 添加 到 设置 表 的 资产 来 源 中 
来 源 修改 | 资产 来 源 按钮 。 将 当前 在 来 源 列表 中 选择 的 来 源 修改 为 来 源 名 称 中 的 新 来 源 名 

来 源 删除 _| 资产 来 源 按钮 。 将 在 来 源 名 称 中 显示 的 来 源 删除 掉 

确定 frm 基本 设置 “| 按钮 。 单 击 该 按钮 将 当前 设置 保存 到 设置 表 中 

关闭 frm 基本 设置 | 按钮 。 单 击 该 按钮 退出 该 窗 体 ， 并 且 不 保存 设置 


| 


在 页 控件 中 ， 资 产 编号 页 界面 效果 如 图 6-20 所 示 。 使 用 部 门 、 资 产 类 别 、 资 产 来 源 3 页 
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的 布局 设计 大 体 一 致 ， 因 此 这 3 页 的 效果 图 仅 给 出 使 用 部 门 设置 图 。 使 用 部 门 的 界面 效果 图 


如 图 6-21 所 示 。 
习 到 
资产 编号 | 使 用 部 门 | 资产 类 别 | 资产 来 源 | 资产 编号 “使 用 部 门 | 资产 类 别 | 资产 来 源 | 
ER: — | Bs: 


二 


图 6-20 资产 编号 设置 图 6-21 使 用 部 门 设置 


要 建立 该 窗口 ， 可 参照 步骤 操作 。 由 于 使 用 部 门 页 和 资产 类 别 、 资 产 来 源 页 结构 类 似 。 
以 下 介绍 步骤 时 ， 只 对 资产 编号 与 使 用 部 门 页 的 建立 做 详细 介绍 。 其 他 两 个 页 面 用 户 请 参照 
步骤 中 建立 使 用 部 门 页 面 的 步骤 完 

(1) 在 Excel 2007 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 在 属性 窗口 中 
设置 新 插入 窗 体 的 名 称 属性 为 “frm 基本 设置 ”， 其 他 属性 保持 默认 即 可 ， 如 图 6-22 所 示 。 

(2) 在 工具 箱 中 选择 多 页 控件 ， 然 后 在 窗 体 中 插入 一 多 页 控件 ， 此 时 新 建立 的 多 页 控件 
默认 包含 了 两 个 页 。 在 属性 窗口 依次 将 这 两 个 页 的 名 称 属性 修改 为 “资产 编号 ”和 “使 用 部 
门 ”。 并 将 其 Caption 属性 设置 成 与 其 名 称 属 性 一 致 ， 如 图 6-23 所 示 。 


性 性 -frm 基本 设置 四 
基本 设置 UserFo ”可 


人 
124 


NB0000012& 
0 - tnBorderStyl, 


ey 
图 6-22 ”基本 设置 窗 体 属性 设计 图 6-23 “资产 编号 ”页 设计 效果 

(3) 单 击 多 页 控件 中 的 “资产 编号 ”页 ， 然 后 在 工具 箱 中 选择 框架 控件 。 在 该 页 的 右 侧 
插入 一 个 框架 控件 ， 随 后 在 属性 窗口 中 修改 该 框架 的 Caption 属性 为 “说 明 : ”， 如 图 6-23 
所 示 。 

(4) 在 工具 箱 中 选择 标签 控件 。 在 “资产 编号 ”标签 的 左上 侧 与 框架 控件 内 部 各 插入 一 
标签 控件 ， 然 后 在 属性 窗口 中 修改 这 两 个 标签 的 Caption 属性 ， 第 一 个 标签 的 Caption 属性 为 
“资产 编号 数字 区 总 长 度 : ”， 但 另外 一 个 标签 的 Caption 字符 串 很 长 ， 这 里 不 再 给 出 该 字符 
串 数据 ， 如 图 6-23 所 示 。 

(5) 在 工具 箱 中 选择 文本 框 控件 。 在 “资产 编号 数字 区 总 长 度 : ”标签 的 下 方 插入 一 文 
本 框 控件 。 然 后 在 属性 窗口 中 修改 该 文本 框 的 名 称 属性 为 “数字 长 度 ”。 
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(6) 在 多 页 控件 中 单 击 “ 使 用 部 门 ”页 ， 然 后 在 工具 
箱 中 选择 框架 控件 。 在 “使 用 部 门 ”页 的 左 侧 插 入 一 个 框 
架 控件 。 然 后 在 属性 窗口 中 修改 该 框架 的 Caption 属性 为 

“已 有 部 门 : ”， 如 图 6-24 所 示 。 

(7) 在 工具 箱 中 选择 列表 框 控件 。 在 上 一 步 创建 的 框 
架 控 件 内 插入 一 列表 框 控 件 ， 然 后 在 属性 窗口 中 修改 该 控 
件 的 名 称 属性 为 “部 门 列表 ”。 

(8) 在 工具 箱 中 选择 标签 控件 。 在 “使 用 部 门 ”页 的 
右上 方 插入 一 标签 控件 。 然 后 在 属性 窗口 修改 该 标签 的 ” 图 6.24 “使 用 部 门 ”页 设计 效果 
Caption 属性 为 “部 门 名 称 : ”。 

(9) 在 工具 箱 中 选择 文本 框 控 件 。 在 上 一 步 创 建 的 标签 控件 下 面 插入 一 文本 框 控 件 。 然 
后 在 属性 窗口 修改 该 文本 框 的 名 称 属性 为 “部 门 名 称 ”。 

(10) 在 工具 箱 中 选择 按钮 控件 。 在 刚 插入 的 文本 框 下 方 连续 插入 3 个 按钮 控件 。 然 后 
在 属性 窗口 中 依次 修改 这 些 按钮 的 Caption 属性 为 “添加 ”、“ 修 改 ” 和 “删除 ”， 并 将 其 名 
称 属性 依次 修改 为 “部 门 添加 ”、“ 部 门 修改 ”和 “部 门 删除 ”。 

(11) 复制 “使 用 部 门 ”页 两 次 。 然 后 在 属性 窗口 中 分 别 将 其 名 称 属性 修改 为 “资产 类 
别 ” 和 “资产 来 源 ”， 并 将 其 Caption 属性 设置 为 与 名 称 属性 一 样 ， 如 图 6-25 和 图 6-26 所 示 。 


| 人 用 部门 | 克 产 类别 ” 克 


ya 
出 


图 6-25 “资产 类 别 ” 页 设计 效果 图 6-26 “资产 来 源 ” 页 设计 效果 


(12) 在 工具 箱 中 选择 按钮 控件 。 在 窗 体 的 底部 连续 插入 两 个 按钮 控件 ， 然 后 在 属性 窗 
口中 修改 按钮 的 Caption 属性 分 别 为 “确定 ”和 “关闭 ”， 并 修改 按钮 的 名 称 属 性 依次 为 “ 确 
证 和 “关闭 ” 本 


6.7.2 ” 窗 体 初始 化 与 确定 、 关 闭 按钮 代码 设计 


本 小 节 介 绍 窗 体 初始 化 事件 以 及 确定 和 关闭 按钮 的 代码 设计 。 在 窗口 初始 化 时 ， 需 要 完 
成 的 工作 包括 两 件 事情 ， 分 别 是 设置 资产 编号 页 为 初始 显示 页 、 完 成 对 资产 编号 页 中 控件 的 
初始 显示 。【 确 定 】 按 钮 被 单 击 时， 程序 需要 检测 新 设置 的 数字 长 度 设置 是 否 与 原来 的 设置 
一 致 ， 并 且 根 据 检测 的 结果 决定 工作 敌 是 否 需 要 保存 。【 关 闭 】 按 钮 完成 的 事情 十 分 简单 ， 
只 需要 退出 窗口 即 可 。 
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另外 在 该 窗 体 中 还 定义 了 一 个 局 部 变量 IsConfigChange。 该 变量 用 于 记录 当前 的 设置 是 否 
发 生变 化 ， 以 便于 确认 该 设置 表 是 否 需 要 保存 。 本 小 节 的 代码 十 分 简单 ， 这 里 不 再 给 出 过 程 
的 流程 图 。 以 下 是 窗 体 初始 化 代码 、 确 定 和 关闭 按钮 的 单 击 事件 代码 的 详细 代码 解释 : 

Private Sub UserForm _ Initialize() 

' 将 资产 编号 页 指定 为 窗 体 初始 显示 时 ， 多 页 控件 初始 页 

MultiPage1.Value =0 

' 调 用 资产 编号 页 初始 化 过 程 

初始 化 资产 编号 页 

End Sub 


Private Sub 确定 _Click() 
' 检 查 资产 编号 页 中 数字 长 度 文 本 框 的 最 终 值 是 否 与 设置 表 的 值 一 致 ， 不 一 致 时 保存 结果 


lf 数字 长 度 .Text <> 设置 表 .Cells(2, 1) Then ' 检 测 新 数字 长 度 设置 是 否 与 原 设置 一 臻 
设置 表 .Cells(2, 1) = 数字 长 度 .Text "修改 原 数字 长 度 设置 
lsConfigChange = True "标记 工作 簿 需要 保存 

End 上 f 

' 检 查 lsConfigChange 变量 ， 如 果 是 真 时 ， 保 存 工作 簿 

If lsConfigChange Then ' 检 测 工 作 簿 是 否 需要 保存 
ThisWorkbook.Save 保存 工作 簿 

End If 

Unload Me 

End Sub 


Private Sub 关闭 _Click() 
Unload Me 
End Sub 


6.7.3 ”初始 化 页 过 程 代码 解 释 


在 窗口 的 页 控件 中 包含 了 4 个 页 。 当 这 4 页 被 显示 时 ， 都 首先 需要 对 该 页 中 所 包含 控件 
进行 部 分 设置 。 程 序 通 过 4 个 过 程 分 别 完成 这 4 页 的 初始 显示 设置 ， 这 4 个 过 程 分 别 是 初始 
化 资产 编号 页 、 初 始 化 使 用 部 门 页 、 初 始 化 资产 类 别 页 和 初始 化 资产 来 源 页 。 其 中 后 面 3 个 
过 程 完成 工作 十 分 相似 。 以 下 对 这 4 个 过 程 分 为 两 类 介绍 其 功能 : 
口 ”初始 化 资产 编号 页 ， 资产 编号 页 被 首次 显示 时 需要 从 工作 德 的 设置 工作 表 中 读 取 用 
户 设 置 的 数字 长 度 信 息 。 该 项 设置 用 于 确定 固定 资产 编号 中 数字 的 位 数 。 

口 初始 化 其 他 页 : 初始 化 使 用 部 门 页 、 初 始 化 资产 类 别 页 和 初始 化 资产 来 源 页 完成 工 
作 大 体 相似 。 这 些 被 首次 显示 时 ， 都 需要 从 设置 表 中 获取 数据 ， 初 始 化 列表 控件 的 
项 目 。 该 项 任务 分 别 又 由 各 自 的 重 置 过 程 完成 。 

以 下 是 这 4 个 过 程 的 详细 代码 解释 ， 这 些 过 程 的 流程 都 十 分 简单 ， 不 再 给 出 过 程 的 流 
程 图 。 

' 该 过 程 完成 对 资产 编号 页 的 初始 化 工作 ， 它 在 多 页 控件 页 单 击 事 件 中 被 调用 ， 为 保证 该 过 程 仅 在 资产 编 


号 页 第 一 次 被 显示 时 执行 ， 使 用 了 一 个 局 部 静态 变量 以 便于 计算 该 过 程 当前 被 运行 的 次 数 
Sub 初始 化 资产 编号 页 () 
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Static runCount As Integer 

runCount = runCount + 1 

' 当 改过 程 被 执行 超过 1 次 时 ， 将 会 直接 跳出 该 过 程 
IfrunCount > 1 Then Exit Sub 

数字 长 度 .Text = 设置 表 .Cells(2, 1) 

End Sub 


' 该 过 程 用 于 初始 化 使 用 部 门 页 

Sub 初始 化 使 用 部 门 页 () 

Static runCount As Integer 

runCount = runCount + 1 

' 当 该 过 程 被 执行 超过 一 次 时 ， 终 止 执行 该 过 程 
If runCount > 1 Then Exit Sub 

重 置 部 门 列表 

End Sub 


Sub 初始 化 资产 类 别 页 () 
Static runCount As Integer 
runCount = runCount + 1 
lfrunCount > 1 Then Exit Sub 
重 置 类 别 列表 

End Sub 


Sub 初始 化 资产 来 源 页 () 
Static runCount As Integer 
runCount = runCount + 1 
IfrunCount > 1 Then Exit Sub 
重 置 来 源 列表 

End Sub 


6.7.4 重 置 列表 过 程 代 码 设计 


在 上 面 讲述 的 初始 化 页 过 程 中 ， 后 面 3 个 
过 程 都 通过 调用 一 个 重 置 列 表 过 程 来 完成 各 自 
页 中 列表 控件 项 目的 初始 设置 工作 。 这 3 个 初 
始 化 列表 项 目的 过 程 其 流程 大 体 类 似 ， 首 先 通 
过 获取 设置 表 中 该 存储 信息 所 在 列 的 最 大 行 
号 ， 然 后 通过 一 个 循环 将 这 些 记录 添加 到 列表 
控件 中 。 由 于 3 个 过 程 流程 的 相似 性 ， 以 下 只 
给 出 重 置 部 门 列 表 的 过 程 流程 图 ， 其 他 两 个 过 
程 读 者 可 以 参考 该 流程 图 加 以 理解 。 如 图 6-27 
所 示 的 是 重 置 部 门 列 表 的 过 程 流程 图 。 

以 下 是 这 些 重 置 列表 项 目 过 程 的 详细 代码 
解释 : 
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' 从 设置 表 中 读 取 数 字 长 度 


' 调 用 重 置 部 门 表 过 程 ， 初 始 化 部 门 列表 项 目 


' 调 用 重 置 类 别 列表 过 程 ， 初 始 化 类 别 列表 项 目 


' 调 用 重 置 来 源 列表 过 程 ， 初 始 化 来 源 列表 项 目 


获取 设置 表 中 资产 部 门 列 最 末 行 的 行 号 intRowsCount 
清空 部 门 列表 所 有 项 目 


是 
为 部 门 列表 添加 项 目 


图 6-27 重 管 部 门 列表 过 程 流程 图 


of 
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"该 过 程 将 会 重 置 使 用 部 门 页 中 部 门 列表 列表 框 

Sub 重 置 部 门 列 表 () 

Dim intRowsCount As Integer, i As Integer 

获取 设置 表 中 资产 部 门 列 有 记录 的 最 尾行 的 行 号 

intRowsCount = 设置 表 .Range("B" & Rows.Count).End(xIUp).Row 


部 门 列表 .Clear "清空 部 门 列表 所 有 项 目 

为 部 门 列 表 列 表 框 添加 记录 

Fori= 2 TointRowsCount "循环 设置 表 资 产 部 门 列 所 有 记录 行 
部 门 列 表 .Addltem 设置 表 .Range("B"& i) 为 部 门 列 表 添 加 项 目 

Next 

End Sub 


Sub 重 置 类 别 列表 () 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("C" & Rows.Count).End(xIUp).Row "获取 设置 表 类 别 列 行 数 


类 别 列表 .Clear "清除 类 别 列表 所 有 项 目 

Fori= 2 To intRowsCount "循环 设置 类 别 列表 所 有 记录 行 
类 别 列表 .Addltem 设置 表 .Range("C" & i) 为 类 别 列表 添加 新 项 目 

Next 

End Sub 


Sub 重 置 来 源 列表 () 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("E" & Rows.Count).End(xIUp).Row 获取 设置 表 来 源 列 行 数 


来 源 列表 .Clear "清除 来 源 列表 所 有 项 目 

Fori= 2 To intRowsCount "循环 设置 表 来 源 列 所 有 记录 行 
来 源 列表 .Addltem 设置 表 .Range("E" & i) 为 来 源 列 表 添 加 新 项 目 

Next 

End Sub 


6.7.5 ”多 页 控件 单 击 事件 代码 设计 


以 上 所 介绍 的 4 个 页 初始 化 过 程 都 是 在 多 页 控件 单 击 事件 中 被 激发 的 。 多 页 控件 的 页 标 
签 被 单 击 时 ， 该 单 击 事件 会 捕获 单 击 页 的 索引 号 ， 然 后 程序 根据 该 索引 号 决定 应 该 执行 哪 一 
个 初始 化 页 过 程 。 以 下 是 该 事件 过 程 的 详细 代码 解释 : 

' 当 多 页 控件 被 单 击 时 ， 执 行 以 下 代码 ， 根 据 被 单 击 的 页 的 索引 ， 有 针对 性 地 执行 相应 的 初始 化 代码 

' 多 页 控件 的 页 的 序号 是 从 0 开始 的 

Private Sub MultiPage1_Click(ByVal Index As Long) 

Select Case Index 

Casels=0 
初始 化 资产 编号 页 

Casels=1 
初始 化 使 用 部 门 页 

Casels=2 
初始 化 资产 类 别 页 


Casels=3 


初始 化 资产 来 源 页 
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End Select 
End Sub 


6.7.6 使 用 部 门 页 控件 单 击 事件 代码 设计 


在 部 门 页 中 一 共有 4 个 控件 包含 了 单 击 事件 ， 这 些 控件 分 部 是 部 门 列表 、 删 除 按钮 、 添 


加 按钮 和 修改 按钮 。 部 门 列 表 的 单 击 事件 将 用 户 选择 的 项 目 值 输入 到 【部 门 名 称 】 文 本 框 中 ， 
以 便 修改 该 名 称 。 删 除 按钮 单 击 事件 将 选择 部 门 名 称 删 除 。 添 加 按钮 将 部 门 名 称 文本 框 中 的 
新 部 门 添加 到 设置 表 。 修 改 按钮 将 修改 用 户 选择 的 部 门 名 称 为 新 名 称 。 


对 这 3 个 事件 过 程 的 流程 加 以 介绍 。 
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在 这 4 个 控件 的 单 击 事件 中 ,3 个 按钮 的 单 击 事件 稍微 比较 复杂 。 以 下 分 别 以 文字 和 图 示 


口 ”删除 按钮 单 击 事件 : 单 击 【删除 】 按 钮 后 ， 程 序 首先 获取 了 设置 表 中 使 用 部 门 列 末 
条 记录 所 在 行 号 ， 然 后 依次 检测 该 列 中 所 有 部 门 ， 当 有 部 门 与 用 户 需 删除 的 部 门 相 
同时 ， 程 序 将 删除 该 部 门 信息 ， 最 后 程序 刷新 部 门 列表 框 的 数据 显示 ， 以 同步 用 户 
的 删除 操作 ， 然 后 退出 整个 过 程 。 该 单 击 事件 过 程 的 流程 图 如 图 6-28 所 示 。 

口 添加 按钮 单 击 事件 ， 单 击 【 添 加 】 按 钮 后 ， 程 序 首先 获取 设置 表 中 使 用 部 门 列 末 条 
记录 所 在 行 号 ， 然 后 依次 检测 该 列 中 所 有 部 门 ， 当 有 部 门 与 需 添 加 的 部 门 相同 时 ， 
旦 序 将 提示 部 门 名 已 存在 ， 并 直接 退出 过 程 。 当 检测 完 所 有 的 记录 行 后 仍然 没有 相 
同 记录 时 ， 程 序 将 把 该 部 门 保存 在 部 门 列 最 后 一 行 单元 格 的 下 一 个 单元 格 ， 最 后 程 
序 刷新 部 门 列表 框 的 显示 ， 以 同步 用 户 的 添加 部 门 操作 。 如 图 6-29 所 示 的 是 该 单 击 
事件 过 程 的 流程 图 。 


获取 设置 表 使 用 部 门 列 末 条 记录 行 号 intRowsCount 


获取 设置 表 使 用 部 门 列 末 条 记录 行 号 intRowsCount 


是 
否 
时 本 [名称 是 否 等 于 第 行 部 门 名 称 7 
否 
闻名 称 是 否 等 于 第 行 部 门 名 称 Y 人 


删除 设置 表 部 门 列 第 i 行 单元 格 


重 置 部 门 列表 


保存 新 部 门 
重 置 部 门 列表 


退出 


图 6-28 【删除 】 按 钮 单 击 事件 过 程 流程 图 图 6-29 【添加 】 按 钮 单 击 事件 过 程 流程 图 
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口 ”修改 按钮 单 击 事件 : 单 击 【修改 】 按 钮 后 ， 程 序 首先 获取 设置 表 中 使 用 部 门 列 末 条 
记录 所 在 行 号 ， 然 后 依次 检测 该 列 的 所 有 部 门 记录 。 如 果 有 部 门 与 部 门 列 表 选 择 
项 相同 ， 程 序 将 把 该 部 门 的 名 称 修改 为 部 门 名 称 文本 框 中 的 值 。 该 过 程 的 流程 图 如 
图 6-30 所 示 。 


获取 设置 表 使 用 部 门 列 末 条 记录 行 号 intRowsCount 


部 门 名 称 是 否 等 于 第 i 行 部 门 名 称 ? 


是 
否 
一 一 部门 名 称 是 否 等 于 第 i 行 部 门 名 称 ? 
修改 部 门 名 称 
重 置 部 门 列表 
设置 部 门 列表 选择 项 


图 6-30 【修改 】 按 钮 单 击 事件 过 程 流程 图 


以 下 代码 是 该 多 页 控件 中 各 个 按钮 的 执行 代码 : 


Private Sub 部 门 列表 _Click() 
部 门 名 称 .Text = 部 门 列表 .Text "将 用 户 选择 的 部 门 项 目 填写 到 部 门 名 称 文本 框 


End Sub 


Private Sub 部 门 删除 _Click() 


Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("B" & Rows.Count).End(xIUp).Row ”获取 设置 表 部 门 列 未 行 记 录 行 号 


| 


办 公 应 用 章 第 之 禾 


$A Excel VBA 应 用 开发 经 典 案 例 。 Ja 


Fori= 2 To intRowsCount "循环 部 门 列 所 有 记录 
lf 设置 表 .Range("B" &i) = 部 门 名 称 .Text Then ' 检 测 第 i 个 单元 格 是 否 为 删除 单元 格 
设置 表 .Range("B" & i).Delete xlShiftUp "删除 第 i 个 部 门 单元 格 
重 置 部 门 列表 ' 刷 新 部 门 列表 框 项 目 
Exit Sub ' 退 出 过 程 
End 上 
Next 
End Sub 


Private Sub 部 门 添加 _Click() 
Dim intRowsCount As Integer, i As Integer 


intRowsCount = 设置 表 .Range("B" & Rows.Count).End(xlUp).Row ”获取 设置 表 部 门 列 未 行 记录 行 号 


Fori= 2 To intRowsCount "循环 部 门 列 所 有 记录 
If 设置 表 .Range("B" &i) = 部 门 名 称 .Text Then "检测 第 i 个 单元 格 是 否 与 添加 部 门 重复 
MsgBox "该 部 门 已 经 存在 ! " vbOKOnly + vblnformation, "部 门 重复 " 
Exit Sub "退出 过 程 
End 上 f 
Next 
设置 表 .Range("B" & (intRowsCount) + 1) = 部 门 名 称 .Text ' 添 加 新 部 门 
重 置 部 门 列表 ' 刷 新 部 门 列表 框 项 目 
lsConfigChange = True ' 标 记 工作 簿 需要 保存 
End Sub 


Private Sub 部 门 修改 _Click() 
Dim intRowsCount As Integer, i As Integer 


intRowsCount = 设置 表 .Range("B" & Rows.Count).End(xIUp).Row 获取 设置 表 部 门 列 末 行 记录 行 号 


Fori= 2 To intRowsCount "循环 部 门 列 所 有 记录 
lf 设置 表 .Range("B" & i) = 部 门 名 称 .Text Then ' 检 测 修 改 部 门 名 是 否 有 重复 
MsgBox "该 部 门 已 经 存在 ! " vbOKOnly + vblnformation, "部 门 重复 " 
Exit Sub 
End ff 
Next 
Fori= 2 To intRowsCount "循环 部 门 列 所 有 记录 
lf 设置 表 .Range("B" &i) = 部 门 列表 .Text Then ' 检 测 第 i 个 单元 格 是 否 为 需 修 改 单元 格 
设置 表 .Range("B" & i) = 部 门 名 称 .Text "修改 第 i 个 部 门 为 新 部 门 
IsConfigChange = True "标记 工作 短 需 要 保存 
重 置 部 门 列 表 ' 刷 新 部 门 列表 框 项 目 
部 门 列表 .ListIndex = i- 2 "设置 部 门 列表 被 选 定 项 目 
Exit Sub "退出 过 程 
End If 
Next 
End Sub 


6.7.7 资产 类 别 页 事件 代码 设计 


资产 类 别 页 中 包含 的 控件 被 建立 时 ， 是 直接 通过 复制 使 月 


功能 相似 性 很 大 ， 其 代码 与 使 用 部 门 页 的 代码 相差 也 很 小 。 
体 介绍 。 以 下 是 该 页 中 包含 的 代码 : 
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FT 


面 不 再 对 该 页 的 嫩 


和 件 代码 做 具 


Private Sub 类 别 列表 _Click() 
类 别名 称 .Text = 类 别 列表 .Text 将 用 户 选择 的 资产 类 别 填写 到 类 别名 称 文本 框 
End Sub 


Private Sub 类 别 删除 _Click() 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("C" & Rows.Count).End(xIlUp).Row ' 获 取 设 置 表 类 别 列 末 行 记录 行 号 


Fori= 2 To intRowsCount ' 循 环 类 别 列 所 有 记录 
If 设置 表 .Range("C" & i) = 类 别名 称 .Text Then ' 检 测 第 i 个 类 别名 称 是 否 为 需 删除 类 别 
设置 表 .Range("C" & i).Delete xlShiftUp ' 删 除 第 i 个 类 别 
重 置 类 别 列表 "刷新 类 别 列表 
Exit Sub "退出 过 程 
End 上 f 
Next 
End Sub 


Private Sub 类 别 添加 _Click() 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("C" & Rows.Count).End(xIlUp).Row ' 获 取 设 置 表 类 别 列 末 行 记录 行 号 
Fori= 2 To intRowsCount "循环 类 别 列 所 有 记录 
If 设置 表 .Range("C" & i) = 类 别名 称 .Text Then "检测 第 i 个 类 别名 称 是 否 重 名 
MsgBox "该 类 别 已 经 存在 ! " vbOKOnly + vblnformation, "类 别 重复 " 


Exit Sub 
End If 
Next 
设置 表 .Range("C" & (intRowsCount + 1)) = 类 别名 称 .Text ' 添 加 新 类 别 
重 置 类 别 列表 ' 刷 新 类 别 列表 项 目 
IsConfigChange = True 标记 工作 筹 需 保存 
End Sub 


Private Sub 类 别 修改 _Click() 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("C" & Rows.Count).End(xIUp).Row "获取 设 置 表 类 别 列 末 行 记 录 行 号 


Fori= 2 To intRowsCount "循环 类 别 列表 所 有 记录 
lf 设置 表 .Range("C" & i) = 类 别 列表 .Text Then 检测 第 i 个 类 别名 称 是 否 需 修改 
设置 表 .Range("C" & i) = 类 别名 称 .Text ' 修 改 第 i 个 类 别 的 名 称 
IsConfigChange = True ' 设 置 工作 簿 需要 保存 
重 置 类 别 列表 ' 刷 新 类 别 列表 项 目 
类 别 列表 .Listindex = i- 2 ' 设 置 类 别 列表 被 选 定 项 目 
Exit Sub ' 退 出 过 程 
End If 
Next 
End Sub 


6.7.8 资产 来 源 页 事件 代码 设计 


资源 来 源 页 中 包含 的 事件 代码 和 使 用 部 门 、 资 产 类 别 页 的 代码 十 分 相似 。 以 下 不 再 针对 


各 个 事件 代码 加 以 详细 介绍 。 各 个 事件 的 流程 可 以 参照 使 用 部 门 页 中 的 类 似 事件 加 以 理解 。 


Te 全 


LL 办 公 应 用 齐 党 之 禾 
Excel VBA 应 用 开发 经 典 案例 。 如 有 


Private Sub 来 源 列 表 _Click() 
来 源 名 称 .Text = 来 源 列表 .Text ' 将 用 户 选择 的 资产 来 源 填写 到 来 源 名 称 文本 框 
End Sub 


Private Sub 来 源 删 除 _Click() 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("E" & Rows.Count).End(xIUp).Row "获取 设置 表 来 源 列 末 行 记录 行 号 


Fori= 2 To intRowsCount "循环 来 源 列表 所 有 记录 
上 f 设置 表 .Range("E" & i) = 来 源 名 称 .Text Then ' 检 测 第 i 个 来 源 名 称 是 否 为 需 删除 来 源 
设置 表 .Range("E" & i).Delete xlShiftUp ' 删 除 第 i 个 来 源 
重 置 来 源 列表 "刷新 来 源 列表 
Exit Sub "退出 过 程 
End 上 f 
Next 
End Sub 


Private Sub 来 源 添加 _Click() 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("E" & Rows.Count).End(xlUp).Row ' 获 取 设 置 表 来 源 列 末 行 记录 行 号 
Fori= 2 To intRowsCount "循环 来 源 列表 所 有 记录 
上 f 设置 表 .Range("E" & i) = 来 源 名 称 .Text Then ' 检 测 第 i 个 来 源 名 称 是 否 与 添加 来 源 重 名 
MsgBox "该 来 源 已 经 存在 !", vbOKOnly + vblnformation, "来 源 重复 " 


Exit Sub "退出 过 程 
End ff 
Next 
设置 表 .Range("E" & (intRowsCount + 1)) = 来 源 名 称 .Text ' 添 加 新 来 源 
重 置 来 源 列表 ' 刷 新 来 源 列 表 项 目 
IsConfigChange = True 标记 工作 簿 需要 保存 
End Sub 


Private Sub 来 源 修改 _Click() 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 设置 表 .Range("E" & Rows.Count).End(xIUp).Row "获取 设置 表 来 源 列 未 行 记录 行 号 
Fori= 2 To intRowsCount "循环 来 源 列表 所 有 记录 
If 设置 表 .Range("E" & i) = 来 源 名 称 .Text Then ' 检 测 第 i 个 来 源 是 否 与 修改 后 来 源 重 名 
MsgBox "该 来 源 已 经 存在 ! " vbOKOnly + vblnformation, "来 源 重复 " 


Exit Sub "退出 过 程 
End ff 
Next 
Fori= 2 To intRowsCount "循环 来 源 列表 所 有 记录 
lf 设置 表 .Range("E" & i) = 来 源 列表 .Text Then ' 检 测 第 i 个 来 源 是 否 需要 修改 
设置 表 .Range("E" & i) = 来 源 名 称 .Text "修改 来 源 名 称 
lsConfigChange = True "标记 工作 簿 需要 保存 
重 置 来 源 列表 "刷新 来 源 列表 项 目 
来 源 列表 .ListIndex =i- 2 "设置 来 源 列表 需要 
Exit Sub ' 退 出 过 程 
End ff 
Next 
End Sub 
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6.8 计 提 日 期 窗 体 设计 
计 提 日 期 窗 体 用 于 获取 当前 需要 计 提 折旧 的 日 期 ， 并 将 该 日 期 保存 在 设置 表 中 。 在 计 提 
折旧 时 ， 正 是 使 用 折旧 日 期 与 固定 资产 的 投入 使 用 日 期 比较 判断 是 否 需要 折旧 。 当 然 所 提供 
日 期 所 在 月 份 已 计 提 过 折旧 的 情况 下 ， 当 月 是 不 会 再 重新 计 提 折旧 的 。 


6.8.1 窗 体 界 面 设计 


该 窗 体 的 界面 如 图 6-31 所 示 。 由 于 仅仅 只 需要 获取 计 提 折旧 的 日 期 , 因此 界面 比较 简单 ， 
主要 包含 有 直接 作用 的 功能 控件 如 表 6-4 所 示 。 


表 6-4 计 提 日 期 窗 体 控件 表 


控 件 名 控件 说 明 

Cal 计 提 日 期 日 历 控 件 。 该 控件 用 于 获取 折旧 日 期 ， 在 选择 日 期 时 ， 需 要 具体 到 日 期 
确定 按钮 。 确 认 当前 计 提 折旧 日 期 、 保 存 ， 然 后 开始 计 提 折旧 工作 

取消 按钮 。 退 出 计 提 折 旧 日 期 窗口 


在 默认 情况 下 ， 窗 体 设 计 的 工具 栏 中 并 不 包含 日 历 控件 。 通 过 以 下 步骤 的 操作 可 以 通过 
工具 栏 直接 使 用 日 历 控件 。 首 先 依次 选择 【视图 】|【 工 具 箱 】 命 令 。 然 后 在 工具 箱 空白 处 右 
击 ， 在 弹出 的 快捷 菜单 中 选择 【附加 控件 】 命 令 。 在 弹出 的 【附加 控件 】 对 话 框 中 的 【可 用 
控件 】 列 表 框 中 找到 日 历 控件 ， 选 中 并 确定 即 可 〈 如 图 6-32 所 示 )》 
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[全 上 
图 6-31 计 提 日 期 界面 图 6-32 ”附加 控件 


6.8.2” 窗 体 代 码 设 计 


该 窗 体 的 代码 完成 的 主要 工作 包括 获取 正确 的 计 提 折旧 日 期 、 保 存 计 提 折旧 日 期 、 调 
用 计 提 折旧 公共 过 程 。 这 些 工作 通过 该 窗 体 的 相应 日 历 控件 和 按钮 控件 的 事件 过 程 来 激发 。 
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Excel VBA 应 用 开发 经 典 案例 


在 该 窗 体 包含 了 3 个 事件 代码 ， 分 别 是 窗口 初 
始 化 事件 、【 确定 】 按 钮 单 击 事件 和 【取消 】 
按钮 单 击 事件 。 

窗口 初始 化 时 ， 程 序 将 当前 日 期 显示 在 计 
提 日 期 日 历 控件 上 。 单 击 【 确 定 】 按 钮 时 ， 程 
序 检测 用 户 是 否 输入 了 正确 的 日 期 ， 然 后 分 别 
执行 相应 的 操作 。【 取 消 】 按 钮 被 单 击 时 直接 
退出 窗口 。3 个 过 程 中 【确定 】 按 钮 的 单 击 事件 
较 复杂 ， 以 下 只 给 出 该 过 程 的 流程 图 ， 如 图 6-33 
所 示 。 

以 下 是 该 窗 体 的 具体 代码 解释 : 


日 期 是 否 输入 正确 ? 
是 


保存 计 提 折 旧 日 期 


调用 计 提 折旧 过 程 计 提 折旧 


是 


提示 日 期 选择 错误 


图 6-33 【确定 】 按 钮 单 击 事件 过 程 流程 图 


' 初 始 化 窗 体 ， 将 该 窗 体 首 次 显示 的 日 期 设置 为 设置 表 中 保存 的 日 期 


Private Sub UserForm_lnitialize() 


Cal 计 提 日 期 .Value = Format(Now, "YYYY-MM-DD") 


End Sub 


"卸载 窗 体 

Private Sub 取消 _Click() 
Unload Me 

End Sub 


"保存 计 提 折旧 日 期 并 调用 计 提 折旧 过 程 
Private Sub 确定 _Click() 


"设置 计 提 日 期 控件 显示 日 期 
"卸载 窗口 


"日 历 控件 中 如 果 没有 选择 日 期 ， 将 会 被 确认 为 没有 获取 日 期 ， 通 过 检测 日 历 控件 的 Day 属性 确认 正确 


输入 日 期 

If 计 提 日 期 .Day Then 
设置 表 .Range("D2") = Cal 计 提 日 期 .Value 
计 提 折旧 


"检测 计 提 日 期 是 否 设置 正确 
"保存 计 提 折 旧 日 期 
"开始 计 提 折 旧 


是 结构 用 于 确认 用 户 是 否 继续 计 提 折旧 ， 单 击 确定 按钮 时 ， 不 退出 窗 体 ， 可 以 继续 选择 其 他 计 提 日 


期 继续 计 提 折 旧 


上 MsgBox(" 计 提 折 旧 完 成 ， 是 否 继续 ", vbOKCancel + vblnformation) = vbCancel Then 


Unload Me 
End If 
Else 


' 提 示 计 提 日 期 选择 不 正确 


"卸载 窗 体 


MsgBox "请 选中 一 个 日 期 ! ", vbOKOnly + vblnformation ' 提 示 计 提 日 期 选择 不 正确 


End If 
End Sub 


6.9 进度 窗 体 设计 


在 国定 资产 登记 操作 中 ， 当 固定 资产 所 有 信息 项 目 都 输入 后 选择 保存 时 ， 程 序 需要 将 该 


1T6D 


固定 资产 的 信息 写 入 对 应 该 固定 资产 的 一 个 单独 


固 


定 资产 折旧 明细 表 中 ， 还 要 将 该 条 固定 资 


wh 
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产 信息 写 入 固定 资产 登记 表 中 。 该 操作 中 数据 读 写 操作 很 频繁 ， 另 外 还 涉及 到 新 建 表 对 象 操 
作 ， 可 能 造成 程序 暂时 的 无 反应 现象 。 为 了 避免 让 用 户 误 认 为 程序 挂 起， 程序 使 用 了 进度 条 
窗口 ， 以 便于 提示 保存 固定 资产 信息 工作 的 进度 状况 。 
由 于 该 窗 体 的 界面 仅 包 含 了 一 个 进度 条 控件 ， 窗 体 的 界面 设计 比较 简单 ， 本 节 将 不 分 开 
讲述 界面 设计 。 在 默认 的 窗 体 设计 工具 箱 中 ， 并 没有 进度 条 ， 要 调用 该 控件 ， 首 先 要 引 | 
Microsoft Windows Common Controls 6.0， 选 择 【 工 具 】|【 引 用】 命令 ,然后 在 【引用 】 窗 口 
中 找到 该 控件 ， 单 击 【 确 定 】 按 钮 即 可 ; 接着 在 工具 箱 上 右 击 ， 在 弹出 的 快捷 菜单 中 选择 【 附 
加 控件 】 命 令 ， 选 择 Microsoft ProgressBar Control,Version6.0 之 后 ， 即 可 在 工具 箱 中 直接 选择 
进度 条 控件 。 该 窗 体 的 界面 如 图 6-34 所 示 。 

该 窗 体 仅 包含 一 个 窗 体 激 活 事件 过 程 。 在 该 窗 体 的 事件 代码 中 ， 有 两 个 循环 ， 分 别 完成 
向 固定 资产 明细 表 写 入 数据 和 向 固定 资产 统计 表 写 入 数据 。 两 个 循环 写 入 的 数据 都 一 样 ， 因 
而 在 计算 进度 时 ， 将 整个 进度 划分 成 两 块 ， 各 占 50%。 例 如 计算 写 入 资产 明细 表 时 ， 进 度 条 
的 值 为 Int(i/ UBound(myArray) * 50)。i/2*UBound(myArray) 得 到 的 是 当前 循环 的 该 次 循环 在 
整个 进度 中 占 的 比例 。 因 为 进度 条 控件 的 值 不 需要 百 分 号 ， 所 以 需要 乘 以 100， 然 后 对 该 值 取 
整 。 该 过 程 的 执行 流程 图 如 图 6-35 所 示 。 


用 数组 myArray 记录 资产 折旧 明细 表 中 需要 修改 的 单元 格 
复制 折旧 明细 表 模板 
命名 新 折旧 明细 表 


是 


设置 myAmay 数 组 第 i 个 元 素 对 应 单元 格 的 值 


FE > 


[I [I 
6-34 固定 资产 登记 保存 进度 图 6-35 进度 窗口 激活 事件 流程 图 
该 过 程 的 详细 代码 解释 如 下 : 
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Private Sub UserForm_Activate() 
Dim ws As Worksheet, myArray() As Variant, i As Integer 
Dim intRowsCount As Integer 
' 用 数组 记录 固定 资产 折旧 明细 表 中 需要 修改 的 单元 格 ， 以 便于 循环 操作 
myArray = Array("K1", "B3", "B4", "B5", "B6", "F3", "F4", "F5", "F6", _ 
wl el he ee ee a te bs a 
' 关 闭 工作 簿 刷新 
Application.ScreenUpdating = False 
复制 单项 固定 折旧 明细 模板 表 ， 新 产生 的 工作 表 位 于 该 表 的 前 面 
单项 资产 折旧 明细 模板 .Copy Before:=Worksheets(" 单 项 固定 资产 折旧 明细 模板 ") 
With ActiveSheet 
"新 的 工作 表 的 标签 名 修改 为 "MX-" + 资产 编号 + "-" 资 产 名 称 的 格式 
.Name = "MX-" & 资产 登记 表 .Range("B3") & "-" & 资产 登记 表 .Range("B4") 
Fori= 0 To UBound(myArray) 
' 向 资产 明细 表 写 入 数据 
.Range(myArray(i)).Formula = 资产 登记 表 .Range(myArray(i)).Formula 
"修改 进度 条 显示 状态 
ProgressBar1.Value = Int(i / UBound(myArray) * 50) 
Next 
End With 
intRowsCount = 资产 登记 统计 .Range("B" & Rows.Count).End(xIUp).Row 
Fori= 0 To UBound(myArray) 
' 将 固定 资产 登记 信息 写 入 资产 登记 统计 
资产 登记 统计 .Cells(intRowsCount + 1, i+ 2) = ActiveSheet.Range(myArray(i)) 
"修改 进度 条 显示 状态 ， 因 为 前 面 已 经 完成 了 50% 的 工作 ， 所 以 该 值 需要 加 上 50 
ProgressBar1.Value = 50 + Int(i/ UBound(myArray) * 50) 
Next 
重新 激活 资产 登记 表 ， 开 启 工作 簿 刷新 并 印 载 窗 体 
资产 登记 表 .Activate 
Application.ScreenUpdating = True 
Unload Me 
End Sub 


6.10 利用 数据 窗 体 设计 


利用 数据 窗 体 用 于 显示 在 固定 资产 登记 统计 表 中 已 经 登记 过 的 固定 资产 的 详细 信息 ,该 窗 
体 被 固定 资产 登记 表 中 的 利用 数据 按钮 所 调用 。 通 过 在 该 窗 体 中 单 击 按钮 ， 当 前 被 选择 的 固 
定 资产 的 数据 会 自动 写 入 到 固定 资产 登记 表 中 。 如 果 当 前 可 
需要 登记 的 固定 资产 的 各 个 数据 和 当前 选择 的 固定 资产 
类 似 ， 可 以 使 用 该 方法 迅速 建立 资料 。 


6.10.1 窗 体 界面 设计 


该 窗 体 包含 的 控件 数量 少 , 此 处 不 再 列 出 表格 一 一 介 
绍 。 窗 体 的 界面 效果 如 图 6-36 所 示 ， 包 含 的 控件 有 : i 


LzA 


- 
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口 ListView 控件 。 显 示 在 固定 资产 登记 统计 表 中 已 经 登记 过 的 固定 资产 的 详细 信息 。 

口 【确定 】 按 钮 。 单 击 该 按钮 后 ， 当 前 选择 的 固定 资产 的 信息 会 写 入 资产 登记 表 中 ， 
类 似 于 在 该 项 固定 资产 上 双击 。 

口 【取消 】 按 钮 。 单 击 该 按钮 后 ， 将 会 退出 该 窗 体 。 


6.10.2 窗 体 初始 化 代码 设计 


在 窗 体 的 初始 化 事件 中 ， 主 要 完成 的 是 ListView 控件 的 显示 设置 。 要 完成 该 控件 的 显示 
设置 ， 程 序 将 该 工作 分 为 3 个 步骤 。 首 先 程序 设置 了 该 控件 部 分 显示 属性 ， 然 后 初始 化 了 该 
控件 的 列 头 ， 最 后 为 该 控件 添加 显示 项 目 。 

控件 列 头 数据 的 来 源 是 资产 登记 统计 表 第 一 行 的 数据 。 程序 通过 一 个 For 循环 将 这 些 数据 
依次 写 入 控件 的 列 头 中 。 控 件 中 所 有 项 目的 数据 来 源 是 资产 登记 统计 表 中 登记 的 固定 资产 数 
据 。 添 加 项 目 时 ， 程 序 通 过 一 个 嵌 套 For 循环 依次 为 控件 添加 新 项 目 ， 然 后 再 为 新 项 目 添加 子 
项 。 如 图 6-37 所 示 的 是 窗口 初始 化 的 过 程 流程 图 。 


图 6-37 窗口 初始 化 流程 图 
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以 下 是 该 窗 体 初始 化 过 程 的 详细 代码 解释 : 
' 该 数组 记录 需要 读 写 的 各 个 单元 格 的 位 置 ， 以 便于 对 这 些 单元 格 进行 循环 操作 
Dim myArray() As Variant 


窗 体 初始 化 代码 

Private Sub UserForm_lnitialize() 

Dim i As Integer, intRowsCount As Integer 

Dim 列表 项 As Listltem, j As Integer 

' 将 需要 读 写 操作 的 单元 格 位 置 写 入 数组 中 

myArray = Array("K1", "B3", "B4", "B5", "B6", "F3", "F4", "F5", "F6", _ 
ee et i i a te EGG 

获得 资产 登记 表 中 最 后 一 项 固定 资产 所 在 的 行 号 

intRowsCount = 资产 登记 统计 .Range("B" & Rows.Count).End(xIUp).Row 


With ListView1 
.ColumnHeaders.Clear "清除 列 头 
.Listltems.Clear ' 清 除 所 有 项 目 
.View = lvwwReport "设置 显示 模式 为 lvwReport 报告 形式 
.FullRowSelect = True "设置 整 行 选择 FullRowSelect 属性 
.Gridlines = True "设置 显示 网 格 线 
.Sorted = True "设置 排列 
.HideSelection = False ' 窗 体 失去 焦点 时 ， 被 选择 的 项 目 以 灰色 背景 显示 
' 获 得 ListView 控件 的 所 有 列 头 ， 这 些 数 据 位 于 资产 登记 统计 表 中 第 一 行 ， 其 中 第 一 列 被 返回 按钮 
占据 
Fori=0ToUBound(myArray) 
.ColumnHeaders.Add , ， 资 产 登 记 统计 .Cells(1, i + 2) ' 添 加 新 列 标题 
Next 
' 向 ListView 控件 添加 项 目 
Fori= 2 To intRowsCount "循环 资产 登记 统计 表 所 有 记录 行 


"首先 为 ListView 控件 建立 一 新 项 目 ， 把 该 项 目 对 象 赋予 给 一 个 对 象 变量 “列表 项 ” 
Set 列表 项 = .Listltems.Add(i -1, ,资产 登记 统计 .Cells(i, 2)) ,添加 新 项 目 


"修改 该 项 目 中 的 子 项 的 内 容 
With 列表 项 
Forj = 1 To UBound(myArray) "循环 所 有 子 项 对 应 列 
.Subltems(j) = 资产 登记 统计 .Cells(i, j + 2) 为 新 项 目 添加 子 项 
Next 
End With 
Next 
End With 
End Sub 


6.10.3 ”窗口 控件 事件 代码 设计 


窗口 中 包含 的 控件 数量 比较 少 ， 代 码 也 不 复杂 。 这 里 将 这 些 控件 的 相关 代码 归纳 为 一 个 
小 节 加 以 介绍 。 窗 口中 有 关 控 件 的 代码 包括 ListView 控件 的 双击 事件 、【 确 定 】 按 钮 的 单 各 
事件 和 【取消 】 按 钮 的 单 击 事件 。 这 几 个 事件 当中 只 有 【确定 】 按 钮 的 代码 较 多 ， 以 下 将 了 


Ht 


是 
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点 介绍 该 事件 。 

当 用 户 在 ListView 控件 中 双击 时 ， 程 序 需要 将 用 户 在 ListView 控件 中 选 定 项 目的 数据 写 
入 资产 登记 表 中 ， 而 【确定 】 按 钮 所 完成 的 任务 正 是 该 项 工作 ， 因 而 双击 ListView 控件 时 ， 
只 需要 调用 【确定 】 按 钮 单 击 事件 即 可 。 单 击 【 取 消 】 按 钮 时 直接 退出 窗口 。 

单 击 【 确 定 】 按 钮 时 ， 程 序 将 把 用 户 选 定 项 目的 数据 输入 到 资产 登记 表 中 。 首 先 程序 检 
测 了 ListView 控件 中 是 否 有 项 目 被 选 定 ， 然 后 程序 获取 选 定 项 目的 索引 号 ， 最 后 程序 将 对 应 
该 索引 号 的 资产 登记 统计 表 的 记录 数据 写 入 到 资产 登记 表 中 。 

写 入 数据 时 使 用 了 一 个 For 循环 ， 该 循环 通过 循环 myArray 定义 的 所 有 单元 格 ， 依 次 写 
入 数据 。 但 是 该 数组 中 的 单元 格 地 址 还 包含 了 使 用 公式 的 单元 格 ， 这 些 单元 格 是 不 需要 赋值 
的 ， 这 些 公式 单元 格 会 自动 重新 计算 获取 值 ， 因 而 需要 在 循环 中 排除 这 些 单元 格 的 赋值 操作 。 
如 图 6-38 所 示 的 是 【确定 】 按 钮 单 击 事件 过 程 的 流程 图 。 


一 [9Viem 控 件 有 项 目 被 远 中 了? 
是 
区 到 被 这 择 的 项 目的 家 引 niRow 
否 


是 
SEEYG 所 指 单元 格 为 非 公式 单元 税 盖 到 


将 资产 登记 表 第 intRow+1 行 ，i+2 列 赋值 
给 资产 登记 表 myArray(i) 所 处 单元 格 


图 6-38 【确定 】 按 钮 单 击 事 件 过 程 的 流程 图 


以 下 是 该 窗口 中 控件 的 事件 代码 详细 解释 : 


' 双 击 ListVeiw 控件 时 ， 直 接 执行 确定 按钮 单 击 事件 过 程 ， 将 数据 写 入 表 中 


Private Sub ListView1_DblClick() 
确定 _Click "调用 确定 按钮 单 击 事件 过 程 


End Sub 


"取消 按钮 单 击 事件 
Private Sub 取消 _Click() 


AN 
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Unload Me ' 扼 载 窗 口 
End Sub 


"确定 按钮 单 击 事件 
Private Sub 确定 _Click() 
Dim i As Integer, intRow As Integer 
' 关 闭 工作 簿 刷新 
Application.ScreenUpdating = False 
' 检 查 ListView 控件 中 是 否 有 项 目 被 选中 ， 当 有 项 目 被 选中 时 ， 执 行 以 下 代码 
If Not (ListView1.Selectedltem ls Nothing) Then 
"获取 被 选择 的 项 目的 索引 号 ， 该 索引 号 从 1 开始 
intRow = ListView1.Selectedltem.Index 
Fori= 0 To UBound(myArray) ' 循 环 所 有 需 输入 数据 的 单元 格 
' 如 果 写 入 的 单元 格 不 是 公式 自动 产生 数据 ， 将 该 数据 写 入 到 资产 登记 表 中 
If myArray(i) <> "J5" And myArray(i) <> "J6" And myArray(i) <> "L4" And myArray(i) <> _ 
"L5" And myArray(i) <> "L6" Then 
资产 登记 表 .Range(myArray(i))= 资 产 登 记 统计 .Cells(intRow + 1, i+ 2) ”' 设 置 单元 格 的 值 
End If 
Next 
End If 
Application.ScreenUpdating = True 
End Sub 


6.11 输入 辅助 窗 体 设计 
输入 辅助 窗 体 在 系统 中 一 般 应 用 到 两 个 地 方 : 一 是 在 固定 资产 登记 中 ， 辅 助 输入 固定 资 


息 ， 另 一 个 是 在 首页 中 选择 查看 单项 资产 时 ， 用 于 获取 单项 资产 表 的 名 称 。 在 该 窗 体 中 
双击 需要 的 项 或 选择 该 项 后 单 击 【 确 定 】 按 钮 都 可 以 完成 选择 工作 。 


6.11.1 窗 体 界面 设计 


该 窗 体 的 界面 比较 简洁 ， 窗 体 的 界面 效果 如 图 6-39 所 示 。 该 EE 
窗口 显示 的 是 所 有 已 登记 的 资产 。 Be 


1 
IE-YSQC00001- 轿 车 


其 包含 以 下 控件 : 

口 框架 控件 : 该 控件 用 于 提示 显示 一 些 信 息 ， 也 将 列表 框 
控件 划分 出 来 ， 以 达到 醒目 的 效果 。 

口 “ 列 表 框 控件 :该 控件 用 于 显示 列表 信息 。 针 对 不 同 的 情 
况 ， 列 表 框 将 显示 不 同 的 内 容 。 图 6-39 ”辅助 输入 窗口 界面 

口 【确定 】 按 钮 : 单 击 该 按钮 后 ， 将 记录 该 条 选择 信息 ， 
执行 相应 的 过 程 ， 然 后 退出 该 窗 体 。 
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6.11.2 ” 窗 体 初始 化 与 卸载 事件 代码 设计 


该 窗口 作为 一 个 辅助 输入 窗口 ， 需 要 根据 用 户 的 选择 情况 来 完成 窗口 中 列表 框 项 目的 初 
始 化 工作 ， 因 而 在 窗口 初始 化 时 ， 过 程 稍微 比较 复杂 ， 下 面 将 对 该 事件 的 流程 进行 详细 介绍 。 
窗口 卸载 时 ， 如 果 用 户 没有 选择 任何 项 目 ， 需 要 署 空 存储 选择 结果 的 公共 变量 ， 同 时 还 需要 
设置 变量 “Is 选择 明细 表 ” 为 假 。 

该 窗口 还 会 在 首页 单 击 【 查 看 单项 资产 】 按 钮 时 显示 。 在 这 种 情况 下 显示 窗口 的 设置 与 
其 他 情况 不 具有 相似 性 。 因 而 ， 需 要 根据 “Is 选择 明细 表 ” 公 共 变 量 来 区 别 不 同情 况 的 显示 
操作 。 

当 窗 口 被 初始 化 时 ,程序 首先 根据 “Is 选择 明细 表 ” 公 共 变 量 确认 用 户 是 否 在 首页 单 击 了 
【查看 单项 资产 】 按 钮 。 当 单 击 该 按钮 时 ， 程 序 修改 了 窗口 与 窗口 中 框架 的 Caption 属性 ， 并 
且 依 次 检测 工作 舌 中 所 有 工作 表 ， 将 属于 折旧 明细 的 工作 表 名 称 添加 到 窗口 列表 框 中 。 当 用 
户 在 输入 资产 信息 时 双击 单元 格 ， 程 序 首先 修改 窗口 与 窗口 中 框架 的 Caption 属性 ， 然 后 从 设 
置 表 中 读 取 数 据 填 充 到 列表 框 中 。 

窗口 激活 事件 过 程 的 代码 较 多 ， 而 且 其 中 使 用 了 一 个 Select Case 分 支 结构 。 以 下 为 了 说 
明 的 方便 ， 将 该 过 程 的 流程 分 为 3 个 流程 图 加 以 说 明 ,， 如 图 6-40~ 图 6-42 所 示 。 其 中 第 一 个 流 
程 图 为 主 过 程 流程 图 ， 第 二 个 流程 图 说 明 选 择 明 细 表 时 的 初始 化 操作 ， 第 三 个 流程 图 显示 辅 
助 输入 资产 类 别 时 的 初始 化 操作 。 辅 助 输入 时 不 同情 况 的 程序 流程 大 体 一 致 ， 因 而 这 里 只 说 
明 辅 助 输 入 资产 类 别 的 流程 。 其 他 情况 读者 可 以 参考 该 流程 加 以 理解 。 


资产 类 别 资产 状态 使 用 部 门 资产 来 源 


图 6-40 ”窗口 初始 化 流程 图 
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设置 窗口 与 框架 控件 的 Caption 属 性 


获取 工作 短 第 一 个 工作 表 对 象 ws 


ws 非 最 后 一 个 工作 表 


是 


清空 内 容 列 表 


否 ER 六 
s 是 折旧 明细 工作 表 ? i<=intRowsCount 
是 
是 


列表 框 添加 资产 类 别 项 
下 一 个 工作 表 对 象 


列表 框 添加 ws 工作 表 名 称 


下 一 个 工作 表 对 象 


过 程 其 他 步骤 
图 6-41 选择 明细 表 窗 口 初始 化 流程 图 图 6-42 输入 资产 类 别 窗口 初始 化 流程 图 
以 下 是 该 窗口 的 初始 化 与 外 载 事件 过 程 详细 代码 解释 : 

Dim lsClickOK As Boolean 


Private Sub UserForm_lnitialize() 
Dim i As Integer, intRowsCount As Integer 


Dim ws As Worksheet 
Ifls 选择 明细 表 Then 
Me.Caption = "选择 明细 表 " "设置 窗口 Caption 属性 
frame 外 框 .Caption = "在 列表 中 选择 明细 表 : " "设置 框架 Caption 属性 
For Each ws In ThisWorkbook.Worksheets "循环 工作 簿 中 所 有 工作 表 
If Left(ws.Name, 2) = "MX" Then ' 检 测 工作 表 是 否 为 折旧 明细 工作 表 
内 容 列 表 .Addltem ws.Name "列表 框 添加 工作 表 名 称 
End If 
Next 
Else 
Select Case 辅助 窗口 参数 
Case ls = "资产 类 别 " ' 检 测 辅助 窗口 参数 是 否 为 资产 类 别 
Me.Caption = "资产 类 别 " "设置 窗口 Caption 属性 


frame 外 框 .Caption = "在 列表 中 选择 资产 类 别 : ” "设置 框架 Caption 属性 
获取 设置 表 资 产 类 别 列 未 条 记录 行 号 
intRowsCount = 设置 表 .Range("C" & Rows.Count).End(xIUp).Row 


内 容 列表 .Clear "清除 内 容 列 表 所 有 项 目 
Fori=2TointRowsCount "循环 所 有 资产 类 别 记 录 
内 容 列表 .Addltem 设置 表 .Range("C"& i) ”为 内 容 列表 添加 资产 类 别 项 目 
Next 
Case ls = "资产 状态 " ' 检 测 辅助 窗口 参数 是 否 为 资产 状态 
Me.Caption = "资产 状态 " "设置 窗口 Caption 属性 
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frame 外 框 .Caption = "在 列表 中 选择 资产 状态 : ”' 设 置 框架 Caption 属性 


获取 设置 表 资 产 状态 列 未 条 记录 行 号 
intRowsCount = 设置 表 .Range("D" & Rows.Count).End(xIUp).Row 
内 容 列表 .Clear "清除 内 容 列 表 所 有 项 目 
Fori=2 To intRowsCount "循环 所 有 资产 状态 记录 
内 容 列表 .Addltem 设置 表 .Range("D"& i) ”为 内 容 列 表 添加 资产 状态 项 目 
Next 
Case ls = "使 用 部 门 " ' 检 测 辅助 窗口 参数 是 否 为 使 用 部 门 
Me.Caption = "使 用 部 门 ” "设置 窗口 Caption 属性 


frame 外 框 .Caption = "在 列表 中 选择 使 用 部 门 : ”' 设 置 框架 Caption 属性 
获取 设置 表 使 用 部 门 列 未 条 记录 行 号 
intRowsCount = 设置 表 .Range("B" & Rows.Count).End(xIUp).Row 


内 容 列 表 .Clear ' 清 除 内 容 列 表 所 有 项 目 
Fori=2 To intRowsCount "循环 所 有 使 用 部 门 记录 
内 容 列表 .Addltem 设置 表 .Range("B" &i) 为 内 容 列表 添加 使 用 部 门 项 目 
Next 
Case ls = "资产 来 源 " ' 检 测 辅助 窗口 参数 是 否 为 资产 来 源 
Me.Caption = "资产 来 源 " "设置 窗口 Caption 属性 
frame 外 框 .Caption = "在 列表 中 选择 资产 来 源 : ” "设置 框架 Caption 属性 
获取 设置 表 资 产 来 源 列 未 条 记录 行 号 
intRowsCount = 设置 表 .Range("E" & Rows.Count).End(xIUp).Row 
内 容 列 表 .Clear "清除 内 容 列表 所 有 项 目 
Fori=2 To intRowsCount "循环 所 有 资产 来 源 记录 
内 容 列表 .Addltem 设置 表 .Range("E" & i) ”为 内 容 列表 添加 资产 来 源 项 目 
Next 
End Select 
lsClickOK = False "设置 lsClickOK 为 假 
End If 
End Sub 


Private Sub UserForm_Terminate() 


If Not lsClickOK Then ' 检 测 是 否 单 击 了 确定 按钮 
辅助 窗口 参数 = "设置 辅助 输入 参数 为 空 

End If 

ls 选择 明细 表 = False "设置 选择 明细 表 

End Sub 


6.11.3 ”窗口 控件 事件 代码 设计 


窗口 中 包含 的 控件 数量 不 多 ， 相 关 控件 的 代码 页 不 多 。 窗 口中 只 包含 了 两 个 事件 代码 ， 
分 别 是 列表 控件 双击 事件 和 【确定 】 按 钮 单 击 事件 。 内 容 列 表 被 双击 时 ， 直 接 调用 【确定 】 
按钮 单 击 事件 过 程 。 在 【确定 】 按 钮 单 击 事件 过 程 中 需要 根据 选择 明细 表 变 量 确定 接 下 来 的 
操作 。 以 下 是 窗口 控件 的 事件 代码 详细 解释 : 
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Private Sub 内 容 列表 _DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
确定 _Click "调用 确定 按钮 单 击 事件 过 程 
End Sub 


Private Sub 确定 _Click() 
Ifls 选择 明细 表 Then 
On Error Resume Next 


Worksheets( 内 容 列表 .Text).Select "激活 用 户 选择 的 工作 表 
Else 
lsClickOK = True "设置 isClickOK 变量 为 真 
辅助 窗口 参数 = 内 容 列 表 .Text "存储 用 户 选择 项 目 数据 
End If 
Unload Me 
End Sub 


6.12 公共 代码 模块 设计 


在 该 系统 的 模块 中 ， 包 含 两 个 模块 公共 变量 模块 与 公共 过 程 模 块 。 公 共 变 量 模块 存储 了 
系统 的 所 有 公共 变量 的 定义 。 公 共 过 程 模块 中 存储 的 是 所 有 公共 的 过 程 代码 。 


6.12.1 公共 变量 模块 


公共 变量 模块 定义 了 所 有 系统 需要 使 用 的 公共 变量 。 以 下 代码 解释 了 这 些 公共 变量 的 
用 途 : 


' 该 变量 保存 在 辅助 窗口 中 选择 得 到 的 相关 数据 

Public 辅助 窗口 参数 As String 

"返回 按钮 有 两 种 情况 ， 在 首页 中 操作 后 跳 转 到 其 他 的 页 面 时 ， 返 回 就 是 返回 首页 ; 在 固定 资产 登记 统计 
表 中 页 可 以 双击 项 目 后 跳 转 到 资产 折旧 明细 表 ， 当 在 资产 折旧 明细 表 中 单 击 返回 按钮 时 需要 返回 固定 资 
产 登记 统计 表 。 该 变量 用 于 定义 是 否 返回 资产 登记 统计 表 。 

Public 是 否 返回 统计 表 As Boolean 

"对 于 辅助 输入 窗口 ， 当 是 属于 在 首页 中 选择 查看 单项 资产 折旧 时 ， 该 情况 不 同 于 在 资产 登记 表 中 的 辅助 
输入 情况 ， 用 该 变量 区 别 这 两 种 情况 。 从 而 系统 可 以 针对 两 种 情况 采取 不 同 的 操作 

Public ls 选择 明细 表 As Boolean 


6.12.2 ” 跳 转 按钮 宏 过 程 代码 设计 
在 公共 模块 当中 包含 了 系统 中 跳 转 按钮 的 宏 过 程 代码 ， 这 些 宏 过 程 分 别 完成 系统 中 各 个 


按钮 单 击 时 的 跳 转 任务 。 宏 过 程 的 代码 都 比较 简单 ， 基 本 上 都 是 直接 打开 一 个 窗口 、 激 活 一 
个 工作 表 或 者 调用 某 个 过 程 。 以 下 是 这 些 宏 过 程 的 详细 代码 解释 : 
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Sub 基本 设置 () 
frm 基本 设置 .Show ' 显 示 基 本 设置 窗口 
End Sub 


Sub 折旧 明细 表 () 


ls 选择 明细 表 = True "标记 选择 明细 表 变 量 
frm 输入 辅助 .Show "显示 输入 辅助 窗口 
End Sub 


Sub 固定 资产 登记 () 


资产 登记 表 .Activate "激活 资产 登记 表 工 作 表 
End Sub 
Sub 返回 () 
lf 是 否 返 回 统计 表 Then ' 检 查 是 否 返 回 统计 表 工 作 表 
资产 登记 统计 .Activate "激活 资产 登记 统计 表 工作 表 
Else 
首页 .Activate "激活 首页 工作 表 
End If 
是 否 返回 统计 表 = False "设置 是 否 返 回 统计 表 
End Sub 


Sub 固定 资产 统计 () 

资产 登记 统计 .Activate ' 激 活 资产 登记 统计 表 

End Sub 

Sub 折旧 与 现 值 统计 () 

资产 折旧 与 现 值 统计 .Activate "激活 资产 折旧 与 现 值 统计 工作 表 
End Sub 


Sub 计 提 日 期 () 


frm 计 提 日 期 .Show "显示 计 提 日 期 窗口 
End Sub 

Sub 利用 数据 () 

frm 利用 数据 .Show "显示 利用 数据 窗口 
End Sub 


6.12.3 资产 类 别 拼 音 函 数 代 码 设计 


资产 类 别 拼 音 函 数 根据 获取 的 资产 类 别 字符 串 参数 返回 该 参数 的 拼音 。 该 过 程 首 先 将 资 
产 类 别 字符 串 的 汉字 逐个 保存 到 同等 长 度 的 字符 串 数组 中 ， 然 后 逐个 获取 每 个 汉字 字符 的 拼 
音 头 字母 ， 最 后 将 这 些 拼 音 头 字母 连接 起 来 作为 结果 。 该 过 程 的 流程 图 如 图 6-43 所 示 。 


CA 


是 


获取 数组 第 i 个 字符 的 拼音 头 字 
将 拼音 头 字 连 接 到 资产 类 别 字符 串 


图 6-43 ”资产 类 别 拼音 函数 流程 图 


该 函数 的 详细 代码 解释 如 下 : 


Public Function 资产 类 别 拼 音 (资产 类 别 As String) As String 
Dim myLen As Integer, i As Integer myName() As String 
资产 类 别 拼 音 = "初始 化 函数 返回 值 
"获取 资产 类 别 字 符 串 的 长 度 
myLen = Len( 资 产 类 别 ) 
' 资 产 类 别 的 每 个 汉字 保存 到 数组 myName 
ReDim myName(1 To myLen) As String 
Fori= 1To myLen "循环 资产 类 别 参数 字符 串 中 每 个 字符 
myName(i) = Mid( 资 产 类 别 ,i, 1) ' 将 第 i 个 字符 保存 到 数组 中 
Next 
"获取 客户 名 称 的 汉语 拼音 的 第 一 个 字母 
Fori= 1TomyLen 
资产 类 别 拼音 = 资产 类 别 拼音 & 拼音 头 字母 (myName(i)) 获取 汉语 字符 的 拼音 头 字 母 
并 连接 
Next 
End Function 
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6.12.4 拼音 头 字 母 函 数 代 码 设 计 


拼音 头 字母 函数 根据 获取 的 汉字 参数 ， 返 回 该 汉字 的 拼音 头 字母 。 程 序 通过 一 个 多 支 的 
下 语句 逐个 将 汉字 的 ASCII 码 与 字符 表 每 个 字符 的 首位 汉字 进行 比较 。 当 该 汉字 的 ASCII 码 
的 值 落 在 某 个 字母 的 首尾 汉字 ASCII 码 之 间 时 ， 程 序 即 会 获取 返回 结果 。 如 图 6-44 所 示 的 是 
该 函数 的 流程 图 : 


获取 汉字 字符 的 ASCII 码 并 保存 到 变量 1 
获取 A 字母 首尾 汉字 ASCII 码 


一 一 | 蚌 瑚 洲 在 字母 首尾 汉字 的 ASCII 码 之 间 
字母 表 下 一 个 字母 
返回 汉字 拼音 首 字母 
图 6-44 ”拼音 头 字 母 函数 流程 


在 下 面 的 代码 中 ， 只 通过 一 个 下 语句 来 描述 比较 结果 。 
Public Function 拼音 头 字母 (myChar As String) As String 


Dim i As Long 

i= Asc(myChar) 

Ifi >= Asc(" 啊 ") And i < Asc(" 芭 ") Then 
拼音 头 字母 = "A" 

Elselfi >= Asc(" 芭 ") And i < Asc(" 擦 ") Then 
拼音 头 字母 = "B" 

Elselfi >= Asc(" 擦 ") And i < Asc(" 搭 ") Then 
拼音 头 字母 = "C" 

Elselfi >= Asc(" 搭 " And i < Asc(" 蛾 ") Then 
拼音 头 字母 = "D" 

Elselfi >= Asc(" 蛾 " And i < Asc(" 发 ") Then 
拼音 头 字母 = "E" 

Elselfi >= Asc(" 发 " And i < Asc(" 嘲 ") Then 
拼音 头 字母 = "F" 

Elselfi >= Asc(" 嘲 ") And i < Asc(" 哈 ") Then 
拼音 头 字母 = "G" 

Elselfi >= Asc(" 哈 ") And i < Asc(" 击 ") Then 
拼音 头 字母 = "H" 

Elselfi >= Asc(" 击 ") And i < Asc(" 喀 ") Then 
拼音 头 字母 = "J" 

Elselfi >= Asc(" 喀 ") And i < Asc(" 垃 ") Then 
拼音 头 字 母 = "K" 

Elselfi >= Asc(" 垃 ") And i < Asc(" 妈 ") Then 


"获取 汉字 字符 的 ASCII 码 

与 A 字 母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 A 

与 B 字 母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 B 

与 C 字母 的 首尾 汉字 ASCII 码 比 较 
' 函 数 返 回 值 为 C 

与 D 字 母 的 首尾 汉字 ASCII 码 比 较 
' 函 数 返 回 值 为 D 

"与 E 字 母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 E 

' 与 F 字母 的 首尾 汉字 ASCII 码 比 较 
' 函 数 返 回 值 为 F 

与 G 字母 的 首尾 汉字 ASCII 码 比 较 
' 函 数 返 回 值 为 G 

与 H 字母 的 首尾 汉字 ASCII 码 比 较 
' 函 数 返 回 值 为 H 

与 J 字母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 J 

与 K 字母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 K 

"与 上 字母 的 首尾 汉字 ASCII 码 比较 
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拼音 头 字母 = "L" "函数 返回 值 为 上 

Elselfi >= Asc(" 妈 ") And i < Asc(" 拿 ") Then 与 M 字母 的 首尾 汉字 ASCII 码 比较 
拼音 头 字母 = "M" ' 函 数 返回 值 为 M 

Elselfi >= Asc(" 拿 ") And i < Asc(" 哦 ") Then "与 N 字母 的 首尾 汉字 ASCII 码 比 较 
拼音 头 字母 = "N" ' 函 数 返 回 值 为 N 

Elselfi >= Asc(" 哦 " And i < Asc(" 哟 ") Then 与 O 字母 的 首尾 汉字 ASCII 码 比 较 
拼音 头 字母 = "O" ' 函 数 返 回 值 为 O 

Elselfi >= Asc(" 鄙 ") And i < Asc(" 欺 ") Then 与 P 字 母 的 首尾 汉字 ASCII 码 比较 
拼音 头 字母 = "P" ' 函 数 返回 值 为 P 

Elselfi >= Asc(" 欺 ") And i < Asc(" 然 ") Then 与 Q 字母 的 首尾 汉字 ASCII 码 比 较 
拼音 头 字母 = "Q" ' 函 数 返 回 值 为 Q 

Elselfi >= Asc(" 然 ") And i < Asc(" 撤 ") Then "与 R 字 母 的 首尾 汉字 ASCII 码 比 较 
拼音 头 字母 = "R" ' 函 数 返 回 值 为 R 


Elselfi >= Asc(" 撒 ") And i < Asc(" 塌 ") Then 
拼音 头 字母 = "S" 
Elselfi >= Asc(" 塌 ") And i < Asc(" 挖 ") Then 


与 S 字母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 S 
与 了 字母 的 首尾 汉字 ASCII 码 比 较 


拼音 头 字母 = "T" ' 函 数 返 回 值 为 下 
Elselfi >= Asc(" 挖 ") And i < Asc(" 昔 ") Then 与 W 字母 的 首尾 汉字 ASCII 码 比较 
拼音 头 字母 = "W" ' 函 数 返回 值 为 W 


Elselfi >= Asc(" 昔 ") And i < Asc(" 压 ") Then 
拼音 头 字母 = "X" 

Elselfi >= Asc(" 压 ") And i < Asc(" 臣 ") Then 
拼音 头 字母 = "Y" 

Elselfi >= Asc(" 臣 ") And i <= Asc(" 座 ") Then 
拼音 头 字母 = "Z" 

End If 


与 X 字 母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 X 
与 Y 字母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 Y 
与 乙 字 母 的 首尾 汉字 ASCII 码 比较 
' 函 数 返 回 值 为 Z 


End Function 
6.12.5 ”获取 资产 编号 函数 代码 设计 


获取 资产 编号 函数 根据 提供 的 资产 类 别 参数 确定 该 种 类 型 资产 的 新 资产 编号 。 每 一 种 资 
产 的 资产 编号 都 是 由 两 部 分 构成 : 一 部 分 是 该 资产 类 别 的 拼音 头 字 母 ， 另 外 一 部 分 是 该 资产 
的 数字 编号 段 。 数 字 编 号 段 的 长 度 可 以 由 用 户 在 基础 设置 窗 体 中 进行 设置 。 

该 函数 首先 获取 了 当前 资产 资产 类 别 的 拼音 头 字 母 ， 然 后 程序 获取 该 种 资产 类 别 下 固定 
资产 的 最 大 编号 。 在 获取 该 最 大 编号 时 ， 首 先 在 资产 登记 统计 工作 表 中 的 资产 编号 列 逐 个 检 
测 。 当 资产 编号 的 字母 段 与 当前 资产 类 型 拼音 头 字母 相同 时 ， 程 序 将 该 资产 编号 的 数字 段 与 
最 大 编号 进行 比较 ， 确 认 出 新 的 最 大 编号 。 当 获取 了 最 大 编号 后 ， 在 该 编号 基础 上 加 1 即 可 
获取 该 类 别 资产 的 新 资产 编号 的 数字 段 。 

新 获取 的 资产 编号 数字 段 只 是 一 个 数字 ， 可 能 该 数字 的 长 度 不 够 用 户 设置 的 长 度 。 为 此 
程序 在 后 面 的 代码 中 为 该 数字 段 不 够 长 度 的 位 添加 “0” 字 符 以 占 位。 最 后 程序 将 新 资产 编号 
的 两 个 部 分 连接 起 来 并 返回 给 函数 作为 结果 。 该 函数 的 流程 比较 复杂 ， 以 下 将 该 函数 的 执行 
流程 分 为 两 个 流程 图 加 以 解释 。 其 中 第 一 个 流程 图 是 整个 函数 的 流程 图 ， 如 图 6-45 所 示 。 第 
二 个 流程 图 描述 了 整个 函数 过 程 中 获取 资产 数字 编号 段 的 过 程 ， 如 图 6-46 所 示 。 
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获取 资产 类 别 拼音 头 字母 zzPY 


获取 新 资产 编号 数字 段 数值 zc 编号 


获取 zc 编号 变量 长 度 tempNumber 


将 资产 编号 拼音 字母 段 保存 到 返回 结果 


i<= 设 置 表 .Range("A2") -tempNumber? 


是 
函数 返回 结果 连接 一 个 “0” 字 符 


函数 返回 结果 连接 zc 编号 
图 6-45 ”获取 资产 编号 函数 流程 


初始 化 变量 zc 编号 为 0 
获取 资产 登记 统计 表 末 条 资产 行 号 intRowsCount 


是 


1<=intRowsCount? 


图 6-46 ”确定 资产 编号 数字 段 流 程 
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;办公 应 用 非 党 乞 够 


Excel VBA 应 用 开发 经 典 案例 


以 下 是 该 函数 的 详细 代码 解释 : 

Public Function 获取 资产 编号 (资产 类 别 As String) As String 

Dim zcPY As String, zc 编号 As Integer, intRowsCount As Integer, i As Integer 
Dim tempNumber As Integer 


zcPY = 资产 类 别 拼音 (资产 类 别 ) "获取 资产 编号 的 拼音 字母 段 

zc 编号 =0 "初始 化 资产 编号 数字 段 数值 

获取 资产 登记 统计 表 未 条 记录 行 号 

intRowsCount = 资产 登记 统计 .Range("C" & Rows.Count).End(xIUp).Row 

If intRowsCount <> 1Then ' 检 测 资 产 登记 统计 表 记 录 是 否 超 过 一 个 
Fori= 2 To intRowsCount "循环 资产 登记 统计 表 所 有 记录 


' 检 测 第 i 行 资产 是 否 属于 当前 资产 类 别 
lf Left( 资 产 登记 统计 .Range("C" & i), Len( 资 产 类 别 )) = zcPY Then 
' 保 存 第 i 行 资产 编号 的 数字 段 数值 
tempNumber = CInt(Right( 资 产 登 记 统计 .Range("C" & i), Len( 资 产 登记 统计 .Range("C" & 
iD)) -Len( 资 产 类 别 ))) 


"确认 最 大 资产 编号 数值 
lf tempNumber > zc 编号 Then zc 编号 = tempNumber 
End If 
Next 
End If 
zc 编号 =zc 编 号 +1 ' 生 成 新 资产 编号 的 数字 段 数值 
tempNumber = Len(CStr(zc 编号 )) "获取 数字 段 数 值 的 位 数 
获取 资产 编号 = 获取 资产 编号 & zcPY ' 函 数 返 回 结果 连接 拼音 字符 串 
Fori = 1To 设置 表 .Range("A2") - tempNumber "循环 产生 固定 位 数 的 资产 编号 数字 段 
获取 资产 编号 = 获取 资产 编号 & "0" ' 函 数 返 回 结果 连接 一 个 “0” 
Next 
获取 资产 编号 = 获取 资产 编号 & zc 编号 ' 函 数 返 回 结果 连接 数字 段 数值 
End Function 


6.12.6 ” 计 提 折旧 过 程 代码 设计 


计 提 折旧 过 程 用 于 对 某 项 固定 资产 计 提 折旧 ， 该 过 程 是 在 用 户 设置 计 提 折旧 日 期 之 后 被 


运行 的 。 计 提 折 旧时 ， 必 须 对 所 有 已 登记 固定 资产 计 提 折旧 。 


为 了 实现 计 提 折旧 功能 ， 程 序 从 资产 登记 统计 工作 表 中 获取 需要 计 提 折旧 的 资产 名 。 然 


后 程序 由 该 资产 名 获取 对 应 该 资产 的 工作 表 对 象 ， 随 后 在 该 资产 折旧 明细 表 中 检测 该 资产 是 
否 需 要 计 提 折旧 。 当 确定 需要 计 提 折旧 后 ， 程 序 在 该 折旧 明细 表 中 添加 一 行 新 折旧 信息 。 在 
填写 固定 资产 折旧 额 时 ， 还 需要 确定 剩余 折旧 额 小 于 月 折旧 额 ， 否 则 直接 填 入 月 折旧 额 时 会 
造成 计 提 的 实际 总 折旧 额 超过 预定 总 折旧 额 ， 随 之 该 固定 自残 净值 出 现 负 值 。 如 图 6-47 所 示 
的 是 该 过 程 的 流程 图 。 
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ff 


第 6 章 固定 资产 策 呆 系统 人 


获取 资产 登记 统计 表示 行 记录 行 号 intRowsCountl 


是 


获取 折旧 明细 表 对 象 ws 


获取 折旧 明细 表 末 行 记 录 行 号 intRowsCount2 
向 折旧 明细 表 插 入 新 折旧 行 


设置 新 折旧 行 的 折旧 日 期 


简 余 折旧 额 是 否 小 于 月 折旧 2? 


退出 


图 6-47 计 提 折旧 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 


Sub 计 提 折旧 () 
Dim ws As Worksheet, intRowsCount1 As Integer, i As Integer, intRowsCount2 As Integer 


获取 资产 登记 统计 表 末 行 记 录 行 号 

intRowsCount1 = 资产 登记 统计 .Range("B" & Rows.Count).End(xIUp).Row 

Fori= 2 To intRowsCount1 "循环 资产 登记 统计 表 中 所 有 资产 
"获取 资产 折旧 明细 表 对 象 
Set ws = Worksheets("MX-" & 资产 登记 统计 .Range("C"& i) & "-" & 资产 登记 统计 .Range("D" & i) 
With ws 


"获取 资产 折旧 明细 表 未 行 记录 行 号 
intRowsCount2 = .Range("A" & Rows.Count).End(xIUp).Row 


lf 是 否 计 提 (ws, 设置 表 .Range("D2")) Then ' 检 测 固 定 资产 是 否 需 要 计 提 折旧 
为 固定 资产 折旧 明细 表 插 入 新 折旧 行 
ws.Rows(intRowsCount2 + 1).Insert shift=xIDown, CopyOrigin:=xIFormatFromLeftOrAbove 
"设置 新 折旧 行 折 旧 日 期 
.Range("A" & (intRowsCount2 + 1)) = Format( 设 置 表 .Range("D2"), "YYYY-M-D") 
' 检 测 剩余 折旧 额 是 否 小 于 月 折旧 额 
f .Range("B6") -.Range("K" & intRowsCount2) -.Range("L4") < .Range("L6") Then 
设置 折旧 额 为 剩余 折旧 额 
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5 办 公 应 用 非 啼 之 禾 


Excel VBA 应 用 开发 经 典 案例 


.Range("J" & (intRowsCount2 + 1))=.Range("B6")-.Range("K" & intRowsCount2)- 


.Range("L4") 
ws.Range("K8") = " 提 足 折 |9" 


资产 登记 统计 .Range("S" & i) = " 提 足 折旧 "” 


Else 


' 在 折旧 明细 表 中 设置 已 提 足 折旧 
' 在 资产 登记 统计 表 中 设置 已 提 足 折旧 


.Range("J" & (intRowsCount2 + 1)) = .Range("L6") "设置 折旧 额 为 月 折旧 额 


End If 
设置 累计 折旧 与 资产 净值 


.Range("K" & (intRowsCount2 + 1)) = .Range("K" & intRowsCount2) + .Range("L6") 
.Range("L" & (intRowsCount2 + 1)) = .Range("B6") -.Range("K" & (intRowsCount2 + 1)) 


End If 
End With 
Next 
End Sub 


6.12.7 是 否 计 提 函数 代码 设计 

是 否 计 提 函数 用 于 确认 某 项 固定 资产 是 否 
需要 计 提 某 个 月 的 折旧 。 是否 对 某 个 固定 资产 在 
某 个 日 期 需要 计 提 折旧 ,影响 的 因素 比较 多 。 这 
些 因素 包括 以 下 几 个 方面 
口 固定 资产 已 经 计 提 该 月 折旧 : 当 用 户 为 
某 固定 资产 建立 了 某 个 月 的 折旧 后 , 该 
固定 资产 的 明细 折旧 表 中 会 登记 该 月 
的 折旧 信息 。 这 种 情况 下 , 程序 需要 检 
测 是 否 有 折旧 记录 存在 。 
口 ”折旧 日 期 必须 在 自残 使 用 日 期 后 : 固定 
资产 折旧 的 日 期 一 般 应 该 设置 在 使 用 
日 期 以 后 ,此 时 需要 检测 该 折旧 日 期 是 
否 在 资产 使 用 日 期 之 前 。 
口 资产 折旧 已 经 计 提 完毕 : 当 固定 资产 的 
折旧 已 经 计 提 完 毕 , 此 时 再 继续 计 提 折 
旧 没 有 意义 。 
函数 对 于 以 上 3 种 情况 , 分 别 使 用 了 3 个 下 
语句 。 对 于 第 一 种 情况 , 程序 需要 在 固定 资产 明 
细 折 旧 表 中 逐 行 检测 ， 因 而 使 用 了 一 个 For 循 
环 。 该 函数 的 整体 结构 比较 简单 ， 如 图 6-48 所 
示 的 是 该 函数 的 流程 图 。 

以 下 是 该 函数 的 详细 代码 解释 : 


获取 ws 工作 表 末 行 记录 行 号 intRowsCount 


否 
资产 计 提 完 折旧 ? 
是 


图 6-48 ”是 否 计 提 函 数 流程 图 


Function 是 否 计 提 (ws As Worksheet, 日 期 As Date) As Boolean 


Dim intRowsCount As Integer, i As Integer 
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intRowsCount = ws.Range("A" & Rows.Count).End(xIUp).Row “获取 工作 表示 行 记录 行 号 


是 否 计 提 = True "设置 函数 返回 为 真 
Fori= 11To intRowsCount "循环 检测 计 提 折旧 日 期 列 所 有 记录 
' 检 测 当 前 日 期 是 否 已 经 计 提 折旧 
If Format(ws.Range("A" & i), "yyyy-m") = Format( 日 期 , "YYYY-M") Then 
是 否 计 提 = False "设置 不 计 提 折旧 
Exit Function ' 退 出 函数 
Endif 
Next 
"确定 计 提 日 期 不 在 资产 使 用 日 期 前 


If Year(ws.Range("F6")) > Year( 日 期 ) _ 
Or (Year(ws.Range("F6")) = Year( 日 期 ) And Month(ws.Range("F6")) >= Month( 日 期 )) Then 


是 否 计 提 = False "设置 不 计 提 折 旧 
Exit Function ' 退 出 函数 
End If 
If ws.Range("K8") = " 提 足 折旧 " Then ' 检 测 是 否 计 提 完毕 折旧 
是 否 计 提 = False "设置 不 计 提 折 旧 
Exit Function "退出 函数 
End If 
End Function 


6.13 系统 测试 


本 小 节 对 系统 中 几 个 比较 重要 的 功能 进行 测试 ， 这 些 功能 包括 固定 资产 登记 、 查 看 固定 
资产 信息 、 计 提 折 旧 和 固定 资产 折旧 与 现 值 统计 。 以 下 将 分 4 个 小 节 ， 以 一 个 固定 资产 管理 
范例 讲述 这 些 功 能 的 操作 过 程 。 实 例 中 建立 的 固定 资产 是 一 部 传真 机 。 


6.13.1 固定 资产 登记 


(1) 在 首页 单 击 【固定 资产 登记 】 按 钮 ， 系 统 自动 跳 转 到 固定 资产 登记 表 中 并 清除 所 有 
数据 ， 如 图 6-49 所 示 。 


BIclD E 到 H I sl kK 
1 加 大 次 产 全 记 胡 | 上 ] 
ES 珊 用 军 限 : 年 计生 单位 ; 
启用 部 门 讳 殊 置 车 : 残 全 
制造 厂商 年 折旧 率 : 月 拆 站 : 
E 妨 周 日 期 竺 折旧 苦 : 月 折 有 : 
3 ES Ea 
LEE -首页 」 加 定 党 产 痘 记 吉 三 -100000L- 志 庄 朋 地 2 王 -55B00001- 手 旨 志 脑 二 -7S3C0000 上 轿车 - 间 项 国定 资 和 
图 6-49 固定 资产 登记 表 
(2) 双击 固定 资产 登记 表 类 别 栏 Kl 单元 格 ， 打 开 【 资 产 类 别 】 对 话 框 ， 如 图 6-50 所 示 。 


选择 办 公设 备 ， 此 时 系统 将 自动 获取 资产 编号 BGSB00002。 在 资产 名 称 B4 单元 格 中 输入 “ 联 
想 台 式 机 ”， 资 产 价值 B6 单元 格 中 输入 7000。 双 击 使 用 部 门 F4 单元 格 ， 打 开 【 使 用 部 门 】 


LUAT， 


对 话 框 ， 如 图 6-51 所 示 。 选 择 财 务 部 ， 在 始 用 日 期 F6 单元 格 中 输入 “2007-12-10”， 耐 用 年 


限 J3 单元 格 中 输入 5。 输入 完成 后 的 结果 如 图 6-52 所 示 。 最 后 单 击 【 保 存 】 按 钮 保存 该 固定 
资产 信息 。 


加 
在 列表 中 选择 资产 类 别 : 一 


图 6-50 【资产 类 别 】 对 话 框 图 6-51 【使 用 部 门 】 对 话 框 
IE ex 
a Blclp E Eleln I Ni x L 

国定 责 产 登记 表 | 类 别 办 公设 备 。 | 
诺 严 国 寻 ”。 65SE00002 天 天 及 冶 用 年 同一 5 和 手 寺 党 人 5 
| 和 而 一重 9 机 一 和 RE 一 一 六 焉 生平 DE ~- 吏 
资产 规格 和 而 年 折旧 素 ， 32700600 月 折 朋 于 人工 6667 
资产 价值 1 000. 而“ 疙 用 日 期 。 2007-1Z10 年 折 月 额 : 140000 月 折旧 干 ， ”116.67 元 


wl a | 


国 昭 归 交 网 加 加 癌 问 册 疾风 


YW | 首页 | 因 定 深 产 若 记 表 。 卫 -TDI0001- 包 库 用 地 ， 取 -本 B00001- 手 提 电 胶 ， 反 -Y50000001- 轿 车。 前 项 因 定 次 7 


图 6-52 ”登记 固定 资产 信息 


6.13.2 ”查看 资产 信息 


首先 返回 首页 ， 然 后 在 首页 中 单 击 【查看 单项 固定 资产 】 按 钮 ， 打 开 【 选 择 明 细 表 】 对 
话 框 ， 如 图 6-53 所 示 。 选 择 最 后 一 个 项 目 ， 此 时 系统 自动 跳 转 到 资产 明细 信息 表 ， 如 图 6-54 
所 示 。 该 明细 表 中 包含 了 固定 资产 的 分 类 账 。 


国 BEar hm 


1 00 月 拉 则 儿 : 


国定 责 产 RR] 


a EE 
上 : 


图 6-53 【选择 明细 表 】 对 话 框 图 6-54 固定 资产 明细 信息 表 
6.13.3” 计 提 折 旧 


(1) 返回 系统 首页 ， 在 首页 中 单 击 【 计 提 折 旧 】 按 钮 ， 在 弹出 的 【设置 计 提 日 期 】 对 话 
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框 中 设置 计 提 日 期 ， 将 年 份 设置 为 2007 年 ， 月 份 设置 为 12 
月 ， 如 图 6-55 所 示 ， 单 击 【确定 】 按 钮 即 可 。 

(2) 系统 计 提 折旧 完成 后 , 会 自动 弹出 一 个 提示 窗口 ， 
如 图 6-56 所 示 。 单 击 【 确 定 】 按 钮 ， 可 以 继续 计 提 折旧 ， 
单 击 【 取 消 】 按 钮 可 以 退出 折旧 操作 。 这 里 还 需要 计 提 2008 
年 1 月 和 2 月 的 折旧 额 ， 因 而 单 击 【 确 定 】 按 钮 ， 同 第 一 步 
操作 ， 分 别 计 提 1 月 和 2 月 的 折旧 即 可 。 所 有 折旧 完成 后 ， 图 6-55 【设置 计 提 日 期 】 对 话 框 
可 以 查看 一 下 刚 登记 的 固定 资产 的 折旧 情况 ， 按 照 6.13.2 节 步 又 打开 刚 登 记 固定 资产 的 明细 
表 即 可 ， 如 图 6-57 所 示 。 


固 因 国 加 出 固 


IEEE ox 
| + 83_|c. 思 六 E 了 | .G. 有 J | J x me ss | 有 | 
? 固定 责 产 登记 表 | 类 别 办 公设 备 
} | 
3 | 资产 编 寻 B55SB00002 芝 产 率 源 : 耐用 年 也 5 各 计量 单 位 ， 
到 | 抽 产 右 永 联想 台式 机 。 使 用 部 门 : 财务 部 兆 现 信和 率 :; 信 : kk. 
5 | 资产 规格 制造 厂商 ; 年 折旧 率 : 20,coo0w A 1, 6667W. 
6 | 资产 价 直 7, 000.00 怒 朋 日产 : 2007-12-10 年 折 旧 帮 :1.400.00 月 折旧 乔 : 116.67 元 
固定 sr 人 kw[E | 
9 凭证 数 二 二 价值 己 他 用 四 + 
有 守 量 单价 ， 司 7 从 放 东 疡 芝 贡 力 。 划 入 i 加 馈 六 人 | 备注 
so is CC 7oow 
12 |2008-1 116.67 115.57 6.883.33 
i) 计 提 折旧 完成 ， 是 否 继 续 13 :2oe-z 11667 23334 6766 66 
EL 


图 6-56 ”提示 窗口 图 6-57 资产 折旧 明细 表 
6.13.4 固定 资产 折旧 与 现 值 
固定 资产 折旧 与 现 值 操作 十 分 简单 ， 只 需 返 回 到 首页 并 单 击 【资产 折旧 与 现 值 】 按 钮 即 


可 ， 程 序 将 自动 完成 所 有 分 析 统 计 显 示 工 作 。 完 成 以 上 操作 后 ， 固 定 资产 的 折旧 与 现 值 统计 
结果 如 图 6-58 所 示 。 


[ 国 EERrxksm -ox 
2 2 局 训 室 D 2 __P 6 1 
固定 资产 新旧 与 现 值 统计 到 器 串 


月 折 _ 了 月 拆 BM | 折旧 马 额 


图 6-58 ”固定 资产 折旧 与 现 值 统计 表 
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第 7 章 进 销 存 管理 系统 


对 于 一 般 的 商贸 公司 ， 进 货 、 销 售 与 存货 的 日 常 处 理 非常 频繁 ， 这 些 工 作 也 是 大 多 数 企 
业经 营 的 管理 核心 ， 数 据 的 变动 性 非常 大 。 购 进 什么 商品 、 购 入 多 少 ， 如 何 减 少 库存 积压 等 
问题 都 会 被 这 些 数据 所 影响 。 如 果 通 过 人 来 记忆 ， 很 难保 证 这 些 数据 的 正确 性 ， 从 而 很 可 能 
造成 断 货 、 商 品 积压 问题 。 使 用 进 销 存 管理 系统 可 以 及 时 了 解 进 销 存 状况 ， 快 速 做 出 反应 。 


7.1 系统 概述 


本 系统 是 一 个 小 型 的 进 销 存 管理 系统 ， 通 过 该 系统 可 以 轻松 完成 各 项 进 销 存 操作 以 及 各 
项 相关 查询 。 通 过 该 系统 获得 的 日 常 进 销 存 数据 ， 可 以 快速 获得 企业 进 销 存 状 况 。 


7.1.1 设计 思路 
系统 共 包含 了 系统 管理 、 基 本 资料 管理 、 进 货 管理 、 销 售 管理 、 库 存 管理 、 资 料 查询 与 


导出 6 个 功能 模块 ， 分 别 对 应 了 该 系统 的 6 个 功能 菜单 。 在 这 些 功能 菜单 中 分 别 又 包含 了 各 
自 的 子 功能 菜单 。 系 统 的 功能 结构 图 如 图 7-1 所 示 。 


进 销 存 管理 系统 
系统 管理 基本 资料 管理 || 进货 管理 “| | 销售 管理 | [库存 管理 资料 查询 与 导出 
供 | 可 | 党 | 
用 商 | “| 进 | | 进 | | 销 || 销 | | 销 | | 库 | | 库 | | 商 | | 昌 
用 | 您 || 修 ‖| 户 || 建 | | 旗 | | 品 | | 货 | | 货 | | 售 || 售 || 售 | | 存 | | 在 | | 资 || 次 [| 次 || 资 [| 次 
改 立 | | 商 料 | | 料 || 料 || 料 
户 || 攻 | 改色 资 | | 日 | | 资 | | 日 || 次 || 统 | | 数 | | 数 | | 料 
用 数 | | 次 查 || 坦 || 查 || 坦 
登 | 有 || 客 || 权 料 | | 常 | | 料 | | 常 || 料 | | 计 | | 据 | | 据 | | 查 || 查 | | 
户 据 | | 料 查 | | 询 | | 询 || 询 | | 询 
录 | 公 | 可 || 管 | 可 | | 可 | | 管 | | 管 | | 查 | | 管 || 查 | | 分 | | 管 | | 查 | | 询 || 电 下 思 || 加 [| 昌 
理 理 | | 理 理 | | 询 理 || 询 | | 析 理 | | 次 | | 总 || 导 || 导 || 导 | 号 
昌 || 电 | 由 | 由 | 


图 7-1 进 销 存 管理 系统 功能 模块 结构 图 


各 模块 的 详细 功能 介绍 如 下 : 

口 系统 管理 模块 该 模块 用 于 用 户 登录 、 用 户 名 修改 、 用 户 密码 修改 、 用 户 权 限 设置 
以 及 创建 数据 库 。 

口 ”基本 资料 管理 模块 : 该 模块 用 于 完成 供 货 商 基 本 资料 和 商品 基本 资料 的 添加 、 修 改 


- 
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和 删除 等 基本 操作 。 

口 ”进货 管理 模块 :该 模块 用 于 完成 日 常 进货 相关 操作 ， 例 如 添加 、 修 改 和 删除 等 进货 
基本 操作 。 该 模块 也 可 以 完成 查询 与 导出 操作 。 

口 ”销售 管理 模块 该 模块 用 于 完成 日 常 销售 相关 操作 ， 例 如 添加 、 修 改 和 删除 等 销售 
基本 操作 。 该 模块 也 可 以 完成 查询 与 导出 操作 。 

口 ”库存 管理 模块 : 该 模块 用 于 完成 日 常 库存 相关 操作 ， 例 如 查询 库存 与 汇总 操作 。 

口 资料 查询 与 导出 模块 ， 在 该 模块 中 可 以 集中 完成 对 供 货 商 资料 、 商 品 资料 、 进 货 、 
销售 、 库 存 的 查询 和 导出 操作 。 


7.1.2 ”知识 点 : 自 定义 菜单 


在 Excel 2007 中 通过 代码 添加 自 定义 菜单 的 方法 很 方便 。 首 先 使 用 MenuBars 的 Add 方法 
添加 菜单 栏 ， 然 后 使 用 该 菜单 栏 的 Menus 属性 的 Add 方法 添加 一 级 菜单 。 添 加 二 级 菜单 时 ， 
应 该 使 用 一 级 菜单 的 MenuItems 属性 的 Add 方法 。 下 面 是 一 个 简单 的 实例 : 

Sub Auto_Open() 

MenuBars.Add " 自 定 义 菜单 " 

为 自 定义 菜单 栏 添加 菜单 

MenuBars(" 自 定义 菜单 "Menus.Add "一 级 菜单 " 

为 菜单 添加 子 菜单 ， 并 指定 宏 

With MenuBars(" 自 定义 菜单 ").Menus(" 一 级 菜单 ).Menultems 

.Add "二 级 菜单 -1", "二 级 菜单 -1 执行 过 程 " 
.Add "-" 
.Add "二 级 菜单 -2", "二 级 菜单 -2 执行 过 程 " 

End With 

End Sub 


通常 对 于 自 定义 的 菜单 栏 ， 在 退出 工作 夭 时 ， 应 该 清除 该 自 定义 工具 栏 。 不 完成 这 些 操 
很 容易 造成 菜单 栏 混乱 。 删 除 的 方法 如 下 : 
Private Sub Workbook_ BeforeClose(Cancel As Boolean) 


MenuBars(" 自 定义 菜单 ").Delete 
End Sub 


作 


7.2 ”Access 数据 库 设 计 


本 系统 以 Access 数据 库 作为 后 台数 据 库 ， 在 本 系统 的 Excel 表 中 不 保存 相关 数据 ， 但 是 
用 户 的 密码 设置 保存 在 工作 表 中 。 其 中 的 数据 都 通过 ADO 数据 库 对 象 操作 。 


7.2.1 数据 表 设 计 


在 建立 该 Access 数据 前 ， 首 先 需要 完成 的 工作 就 是 设计 各 个 表 包 含 的 字段 。 该 数据 库 


y 
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包含 了 5 个 数据 表 ， 分 别 是 供 货 商 信息 、 商 品 信息 、 进 货 信息 、 销 售 信息 和 库存 信息 。 各 个 
表 的 设计 状况 如 表 7-1~ 表 7-5 所 示 。 


字段 名 称 
供 货 商 编码 


表 7-1 供 货 商 信息 表 字段 设计 


是 否 允 许 为 空 


供 货 商 名 称 


通讯 地 址 


邮政 编码 
联系 电话 
传真 号 码 


联系 人 


联系 人 电话 


联系 人 Email 
备注 


字段 名 称 
商品 编码 
商品 名 称 
商品 规格 
计量 单位 
最 高 库存 
最 低 库 存 
备注 


字段 名 称 


供 货 商 编码 


商品 编码 
商品 名 称 


商品 规格 
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表 7-4 销售 信息 表 字 段 设计 


字段 名 称 是 否 允 许 为 空 
销售 编码 否 

商品 编码 理 
商品 名 称 否 
商品 规格 否 
计量 单位 否 

销售 数量 否 
销售 单价 再 

销售 日 期 否 

备注 是 

字段 名 称 是 否 允许 为 空 
商品 编码 | 文本 否 
商品 名 称 否 
商品 规格 | 文本 | 否 
计量 单位 | 文 | 否 
库存 数量 否 
库存 单价 | 单 精 度 | 否 

| 单 梢 度 | 


库存 金额 


7.2.2 ”建立 数据 库 代码 


Access 数据 库 文件 中 的 各 个 表 的 结构 ， 在 该 系统 中 是 通过 代码 来 生成 的 ， 这 个 工作 不 需 


要 手动 完成 。 在 程序 所 提供 的 菜单 中 选择 【系统 管理 】| 【建立 数据 库 】 命 令 ， 


系统 会 自动 生 


成 所 有 数据 表 〈 表 中 没有 任何 记录 ) 。 当 选择 该 菜单 后 ， 系 统 执行 了 创建 数据 库 过 程 。 该 过 


程 的 流程 图 如 图 7-2 所 示 。 

创建 到 数据 库 的 链接 | 
| 打开 数据 库 链接 | 
| 凶 建 供 货 商 信息 表 | 
| 创建 商 品 信息 信息 表 
创建 进货 信息 表 
| 创建 销售 信息 表 | 


| 创 峙 库存 信息 表 | 
图 7-2 创建 数据 库 流程 图 
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该 过 程 的 详细 代码 解释 如 下 : 

Public Sub 创建 数据 库 () 
Dim cnn As New ADODB.Connection 
Dim adoxCat As New ADOX.Catalog 
Dim cnnStr As String, SQL As String 
"创建 与 Access 数据 库 链接 的 Connection 对 象 
cnnStr = ThisWorkbook.Path & "\ 进 销 存 数据 库 .mdb" 
' 判 断 数 据 库 是 否 存在 


If Dir(cnnStr) <> "" Then 检测 数据 库 文件 是 否 存 在 


MsgBox "数据 库 已 经 存在 !", vblnformation, "检查 数据 库 " 
Set cnn = Nothing 
Set adoxCat = Nothing 
Exit Sub 
End 上 f 
"建立 Access 数据 库 
cnnStr = "Provider=microsoftjet.oledb.4.0;”_ 
& "Data Source=" & ThisWorkbook.Path & " 进 销 存 数据 库 .mdb;" _ 


& "Jet Oledb:database password=123456;" ' 设 置 数据 库 创建 字符 串 
adoxCat.Create cnnStr 链接 数据 库 


Set mycat = Nothing 

' 创 建 数据 库 链接 对 象 
cnn.ConnectionString = cnnStr 
cnn.Open 

' 创 建 数据 表 “ 供 货 商 信息 ” 

SQL = "create table 供 货 商 信息 " _ 


& "( 供 货 商 编码 varchar(10) not null, 供 货 商 名 称 varchar(40) not null” _ 


& "通讯 地 址 varchar(30) not null, 邮 政 编码 varchar(6) not null," _ 
& "联系 电话 varchar(14) not null, 传 真 号 码 varchar(14) not null," _ 
& "联系 人 varchar(10) not null, 联 系 人 电话 varchar(14) not null,"_ 


& "联系 人 Email varchar(50) not null, 备 注 varchar(50))” ”' 设 置 创 建 供 货 商 信息 表 字 符 串 
cnn.Execute SQL "创建 供 货 商 信息 表 


"创建 数据 表 “ 商 品 信息 ” 

SQL = "create table 商品 信息 "_ 
& "(商品 编码 varchar(10) not null, 商 品名 称 varchar(20) not null,”_ 
& "商品 规格 varchar(10) not null, 计 量 单位 varchar(10) not null," _ 


& "最 高 库存 single not null, 最 低 库存 int not null, 备 注 varchar(50))” ' 设 置 创建 商品 信息 表 
字符 串 

cnn.Execute SQL "创建 商品 信息 表 
"创建 数据 表 “ 进 货 信息 ” 
SQL = "create table 进货 信息 "_ 

& "(进货 编码 varchar(10) not null, 供 货 商 编码 varchar(10) not null"_ 

& "商品 编码 varchar(10) not null, 商 品名 称 varchar(20) not null"”_ 

& "商品 规格 varchar(10) not null, 计 量 单位 varchar(10) not null"_ 

& "进货 数量 single not null, 进 货 单 价 real not null," _ 

& "进货 日 期 datetime not null, 备 注 varchar(50))" "设置 创建 进货 信息 表 字 符 串 
cnn.Execute SQL "创建 进货 信息 表 


"创建 数据 表 “ 销 售 信息 ” 
SQL = "create table 销售 信息 "_ 
& "(销售 编码 varchar(10) not null, 商 品 编码 varchar(10) not null"”_ 


Ah 
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& "商品 名 称 varchar(20) not null, 商 品 规格 varchar(10) not null,"_ 

& "计量 单位 varchar(10) not null, 销 售 数 量 single not null," _ 

& "销售 单价 real not null, 销 售 日 期 datetime not null, 备 注 varchar(50))" 

"设置 创建 销售 信息 表 字 符 串 

cnn.Execute SQL "创建 销售 信息 表 
"创建 数据 表 “ 库 存 信息 ” 
SQL = "create table 库存 信息 "_ 

& "(商品 编码 varchar(10) not null, 商 品名 称 varchar(20) not null,” _ 

& "商品 规格 varchar(10) not null, 计 量 单位 varchar(10) not null," _ 

& "库存 数量 single not null, 库 存单 价 real not null, 库 存 金额 real not null)" 


"设置 创建 库存 信息 表 字 符 串 
cnn.Execute SQL ' 创 建 库存 信息 表 
MsgBox "数据 库 创 建成 功 ", vblnformation, "创建 数据 库 " 
cnn.Close 
Set cnn = Nothing 
End Sub 


7.3 系统 自 定义 菜单 


由 于 本 系统 的 功能 模块 分 类 比较 多 ， 而 且 每 个 功能 分 类 包含 的 子 功能 块 也 比较 多 ， 所 以 
系统 采用 了 自 定义 菜单 形式 完成 整个 系统 的 导航 操作 。 在 Excel 2007 中 ， 生 成 系统 自 定义 菜 
单 在 加 载 项 中 ， 效 果 图 如 图 7-3 所 示 。 

系统 设置 - 基本 资料 管理 ~ 进货 管理 ~ 销售 答 理 - 库存 管理 - 资料 查询 与 导出 ~ 系统 茶 单 转 撞 ~ 
所定 广 TE 


图 7-3 系统 自 定义 菜单 
7.3.1 子 菜单 设计 


主 菜单 下 分 别 对 应 了 各 自 的 子 菜单 ， 子 菜单 的 内 容 与 该 系统 的 结构 示意 图 相似 。 如 
图 7-4~ 图 7-9 所 示 的 是 各 个 子 菜单 的 图 例 。 


Pe 二 
基本 资料 管理 | ，; 
供 沼 商 管理 
商品 资料 各 理 
图 7-4 系统 设置 子 菜单 图 7-5 基本 资料 管理 子 菜单 
CE 
IE 销 千 日 委 革 至 
进货 日 曙 答 理 名 生 资 料 查 词 与 导出 
进 筑 资料 查询 与 导出 锁 售 统计 分 析 
图 7-6 进货 管理 子 菜单 图 7-7 销售 管理 子 菜单 
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EE 

供 作 刘 资料 查询 与 导出 
两 旺 资料 得 记 与 导出 
Ed Hs 进 质 资 料 查询 与 导出 
库存 窒 科 济 放 销 千 资 和 寺 询 与 导出 
庄 存 资料 得 鹿 与 导出 库存 资 和 得 询 与 导出 

图 7-8 库存 管理 子 菜单 图 7-9 资料 查询 与 导出 子 菜单 


7.3.2 自 定义 菜单 代码 设计 


以 上 的 自 定义 菜单 的 显示 结构 都 是 通过 代码 实现 的 。 
代码 包括 创建 自 定义 菜单 以 及 其 他 所 有 子 菜单 被 单 击 时 
执行 的 过 程 。 如 图 7-10 所 示 的 是 创建 自 定义 菜单 过 程 的 
流程 图 。 

以 下 是 该 过 程 的 详细 代码 解释 : 


Public Sub 创建 自 定义 菜单 () 
On Error Resume Next 
' 清 除 进 销 存 菜单 栏 
MenuBars(" 进 销 存 ").Delete 
' 建 立 一 个 自 定义 菜单 栏 “ 进 销 存 ” 
MenuBars.Add " 进 销 存 " 
' 为 “ 进 销 存 ” 自 定义 菜单 栏 添加 菜单 
With MenuBars(" 进 销 存 ").Menus 
.Add "系统 设置 " 
.Add "基本 资料 管理 " 
.Add "进货 管理 " 
.Add "销售 管理 " 
.Add "库存 管理 " 
.Add "资料 查询 与 导出 " 
End With 
为 各 个 菜单 添加 子 菜单 
' 为 “系统 设置 ”菜单 添加 子 菜单 ， 并 指定 宏 


With MenuBars(" 进 销 存 ").Menus(" 系 统 设置 ").Menultems 


删除 后 并 重新 添加 进 销 存 菜单 栏 
为 进 销 存 菜单 栏 添加 一 级 菜单 


为 各 一 级 菜单 添加 子 菜单 


图 7-10 创建 自 定义 菜单 流程 图 


.Add "用 户 登 录 ", "用 户 登录 窗口 " "添加 菜单 “用 户 登录 ”， 执 行 的 宏 为 “用 户 登 录 窗口 ” 
.Add "~" "添加 菜单 分 割 线 


.Add "修改 用 户 名 " "修改 用 户 名 窗口 " 
.Add "" 
.Add "修改 密码 ", "修改 密码 窗口 " 
.Add "~" 
-Add "用 户 权 限 管理 ", "用 户 权 限 窗口 " 
.Add"" 
.Add "创建 数据 库 ", "创建 数据 库 " 
End With 
' 为 “基本 资料 管理 ”菜单 添加 子 菜单 ， 并 指定 宏 


With MenuBars(" 进 销 存 ").Menus(" 基 本 资料 管理 ").Menultems 


-Add " 供 货 商 管理 ", " 供 货 商 管理 窗口 " 
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.Add "~" 
-Add "商品 资料 管理 ", "商品 资料 管理 窗口 " 


End With 

' 为 “进货 管理 ”菜单 添加 子 菜单 ， 并 指定 宏 

With MenuBars(" 进 销 存 ").Menus(" 进 货 管理 ").Menultems 
.Add "进货 日 常 管理 ", "进货 管理 窗口 " 
.Add "-" 
-Add "进货 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 

End With 

' 为 “销售 管理 ”菜单 添加 子 菜单 ， 并 指定 宏 

With MenuBars(" 进 销 存 ").Menus(" 销 售 管理 ").Menultems 
.Add "销售 日 常 管理 ", "销售 管理 窗口 " 
-Add "-" 
.Add "销售 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 
.Add "-" 
.Add "销售 统计 分 析 ", "销售 统计 分 析 窗 口 " 

End With 

' 为 “库存 管理 ”菜单 添加 子 菜单 ， 并 指定 宏 

With MenuBars(" 进 销 存 ").Menus(" 库 存 管 理 ").Menultems 
.Add "库存 资料 浏览 ", "库存 资料 浏览 窗口 " 
.Add "-" 
.Add "库存 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 

End With 

' 为 “资料 查询 与 导出 ”菜单 添加 子 菜单 ， 并 指定 宏 

With MenuBars(" 进 销 存 ").Menus(" 资 料 查询 与 导出 ").Menultems 
.Add " 供 货 商 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 
.Add "-" 
.Add "商品 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 
.Add "-" 
.Add "进货 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 
.Add "-" 
.Add "销售 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 
.Add "-" 
.Add "库存 资料 查询 与 导出 ", "资料 查询 与 导出 窗口 " 

End With 

' 激 活 “ 进 销 存 ”菜单 栏 

MenuBars(" 进 销 存 ").Activate 

End Sub 


对 于 每 个 子 菜单 而 言 ， 都 有 其 将 执行 的 宏 过 程 ， 这 些 过 程 的 代码 都 比较 简单 。 以 下 是 这 
些 过 程 的 详细 代码 解释 : 
Public Sub 用 户 登录 窗口 () 


登录 .Show 
End Sub 


Public Sub 修改 用 户 名 窗口 () 

' 在 打开 修改 用 户 名 窗口 前 ， 检 测 当 前 是 否 有 用 户 登录 

上 f Len( 登 录用 户 .用 户 名 ) Then ' 检 测 是 否 有 用 户 登 录 
修改 用 户 名 .Show ' 显 示 修改 用 户 名 窗口 


Else 
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MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation 提示 未 登录 
End 上 f 
End Sub 


Public Sub 修改 密码 窗口 () 
' 在 打开 修改 密码 窗口 前 ， 检 测 当前 是 否 有 用 户 登录 
If Len( 登 录用 户 .用 户 名 ) Then "检测 是 否 有 用 户 登录 
修改 密码 .Show "显示 修改 密码 窗口 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation 提示 未 登录 
End If 
End Sub 


Public Sub 用 户 权限 窗口 () 
' 在 打开 用 户 权限 管理 窗口 前 ， 检 测 当前 是 否 有 用 户 登 录 


lf Len( 登 录用 户 .用 户 名 ) Then ' 检 测 是 否 有 用 户 登录 
lf 登录 用 户 .管理 用 户 = True Then ' 检 测 用 户 是 否 具有 管理 权限 
权限 管理 .Show "显示 权限 管理 窗口 
Else 
MsgBox "当前 用 户 没有 权限 管理 用 户 权 限 设置 ! " vbOKOnly + vblnformation “提示 无 管理 权限 
End ff 
Else 


MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation "提示 未 登录 
End If 
End Sub 


Public Sub 供 货 商 管理 窗口 () 
' 在 打开 供 货 商 管理 窗口 前 ， 检 测 当 前 是 否 有 用 户 登 录 并 且 检查 当前 用 户 是 否 有 权限 操作 供应 商 资料 


lf Len( 登 录用 户 . 用 户 名 ) Then "检测 用 户 是 否 登录 
lf 登录 用 户 . 供 货 商 资料 建立 = True Then ' 检 测 用 户 是 否 具有 供 货 商 资料 建立 权限 
供 货 商 资料 管理 .Show "显示 供 货 商 资料 管理 权限 
Else 


MsgBox "当前 用 户 没有 权限 操作 供应 商 资料 ! " vbOKOnly + vblnformation “提示 无 权限 
End If 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation ' 提 示 未 登录 
End If 
End Sub 


Public Sub 商品 资料 管理 窗口 () 
' 在 打开 商品 资料 管理 窗口 前 ， 检 测 当前 是 否 有 用 户 登录 并 且 检 查 当 前 用 户 是 否 有 权限 操作 商品 资料 


lf Len( 登 录用 户 .用 户 名 ) Then ' 检 测 用 户 是 否 登录 
lf 登录 用 户 .商品 资料 建立 = True Then ' 检 测 用 户 是 否 有 商品 资料 建立 权限 
商品 资料 管理 .Show "显示 商品 资料 建立 窗口 
Else 


MsgBox "当前 用 户 没 有 权限 操作 商品 资料 !", vbOKOnly + vblnformation “ ”' 担 示 无 权限 
End ff 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation "提示 未 登录 
End If 
End Sub 
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Public Sub 进货 管理 窗口 () 
' 在 打开 进货 管理 窗口 前 ， 检 测 当前 是 否 有 用 户 登 录 并 且 检 查 当 前 用 户 是 否 有 权限 操作 进货 


lf Len( 登 录用 户 .用 户 名 ) Then ' 检 测 用 户 是 否 登录 
If 登录 用 户 .进货 = True Then ' 检 测 用 户 是 否 有 商品 资料 建立 权限 
进货 资料 管理 .Show ' 显 示 进货 资料 管理 窗口 
Else 


MsgBox "当前 用 户 没 有 权限 操作 进货 管理 ! " vbOKOnly + vblnformation ”提示 无 权限 
End If 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation 提示 未 登录 
End 上 f 
End Sub 


Public Sub 销售 管理 窗口 () 
' 在 打开 销售 管理 窗口 前 ， 检 测 当 前 是 否 有 用 户 登录 并 且 检 查 当前 用 户 是 否 有 权限 操作 销售 管理 


If Len( 登 录用 户 .用 户 名 ) Then ' 检 测 用 户 是 否 登 录 
lf 登录 用 户 .销售 = True Then ' 检 测 用 户 是 否 有 销售 管理 权限 
销售 资料 管理 .Show ' 显 示 销售 资料 管理 窗口 
Else 


MsgBox "当前 用 户 没有 权限 操作 销售 管理 ! " vbOKOnly + vblnformation  ' 提 示 无 权限 
End ff 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation "提示 未 登录 
End If 
End Sub 


Public Sub 销售 统计 分 析 窗 口 () 
' 在 打开 销售 分 析 窗口 前 ， 检 测 当 前 是 否 有 用 户 登录 并 且 检 查 当前 用 户 是 否 有 权限 操作 销售 分 析 


lf Len( 登 录用 户 .用 户 名 ) Then ' 检 测 用 户 是 否 登录 
lf 登录 用 户 .销售 分 析 = True Then ' 检 测 用 户 是 否 有 销售 统计 分 析 管理 权限 
销售 统计 分 析 .Show "显示 销售 统计 分 析 窗口 
Else 


MsgBox "当前 用 户 没 有 权限 进行 销售 分 析 ! " vbOKOnly + vblnformation 提示 无 权限 
End ff 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation 提示 未 登录 
End If 
End Sub 


Public Sub 库存 资料 浏览 窗口 () 
' 在 打开 库存 管理 窗口 前 ， 检 测 当 前 是 否 有 用 户 登录 并 且 检 查 当前 用 户 是 否 有 权限 操作 库存 


lf Len( 登 录用 户 .用 户 名 ) Then ' 检 测 用 户 是 否 登录 
lf 登录 用 户 .库存 = True Then ' 检 测 用 户 是 否 有 库存 资料 管理 权限 
库存 资料 管理 .Show "显示 库存 资料 管理 窗口 
Else 


MsgBox "当前 用 户 没有 权限 操作 库存 管理 ! " vbOKOnly + vblnformation ' 提 示 无 权限 
End If 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! ", vbOKOnly + vblnformation 提示 未 登录 
End If 
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End Sub 


Public Sub 资料 查询 与 导出 窗口 () 
' 在 打开 资料 查询 窗口 前 ， 检 测 当 前 是 否 有 用 户 登录 并 且 检查 当前 用 户 是 否 有 权限 操作 查询 


With 登录 用 户 
fLen(. 用 户 名 ) Then ' 检 测 用 户 是 否 登录 
' 检 测 用 户 是 否 具有 数据 查询 与 导出 权限 
lf . 供 货 商 资料 查询 Or .进货 查询 Or .库存 查询 Or .商品 资料 查询 Or .销售 查询 Then 
资料 查询 与 导出 .Show "显示 资料 查询 与 导出 窗口 
Else 
MsgBox "该 用 户 没有 权限 进行 查询 操作 ! " vbOKOnly + vblnformation “提示 无 权限 
End If 
Else 
MsgBox "您 尚未 登录 系统 ， 请 首先 登录 系统 ! " vbOKOnly + vblnformation “' 提 示 未 登录 
End 上 f 
End With 
End Sub 


7.4 系统 设置 功能 模块 设计 


系统 设置 模块 主要 完成 各 项 有 关系 统 的 设置 工作 ， 包 括 用 户 名 修改 、 密 码 修改 、 权 限 修 
改 以 及 产生 数据 库 。 在 前 面 的 Access 数据 库 设 计 章节 已 经 介绍 了 产生 数据 库 的 过 程 ， 本 章 将 
讲述 该 功能 模块 的 其 余部 分 。 本 系统 的 登录 界面 和 权限 设置 时 使 用 的 权限 设置 登录 窗 体 一 样 ， 
在 本 章节 将 会 介绍 系统 登录 界面 的 设计 。 


7.4.1 系统 公共 变量 


在 系统 中 ， 有 些 变量 是 全 局 变量 ， 为 了 便于 管理 ， 系 统 将 这 些 变量 统一 存放 在 “公共 变 
量 ” 模 块 中 。 这 些 变量 的 具体 解释 如 下 : 

" 自 定义 数据 类 型 登录 信息 ， 用 于 保存 登录 用 户 的 用 户 信息 ， 包 括 用 户 名 、 密 码 以 及 相应 的 权限 设置 
Type 登录 信息 

用 户 名 As String 

密码 As String 

供 货 商 资料 建立 As Boolean 

供 货 商 资料 查询 As Boolean 

商品 资料 建立 As Boolean 

商品 资料 查询 As Boolean 

进货 As Boolean 

进货 查询 As Boolean 

销售 As Boolean 

销售 查询 As Boolean 

销售 分 析 As Boolean 

库存 As Boolean 

库存 查询 As Boolean 

管理 用 户 As Boolean 
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End Type 


' 登 录用 户 是 登录 信息 自 定义 数据 类 型 的 一 个 实例 , 通过 登录 用 户 全 局 变量 可 以 保存 登录 用 户 的 相关 信息 
Public 登录 用 户 As 登录 信息 


7.4.2 用户 登录 设计 


用 户 登录 模块 完成 系统 的 登录 功能 。 在 没有 登录 之 前 ， 系 统 中 的 所 有 功能 都 不 能 使 用 。 
登录 系统 的 窗 体 界面 如 图 7-11 所 示 。 用 户 名 列表 框 控 件 名 称 为 “用 户 名 ”， 密 码 文本 框 名 称 
为 “用 户 密码 ”。 

在 该 窗口 的 代码 中 共 包 含 了 4 个 过 程 ， 分 别 是 窗口 初始 化 过 程 、 刷 新 用 户 列表 过 程 、【 确 
定 】 按 钮 单 击 事 件 过 程 和 【取消 】 按 钮 单 击 事件 过 程 。 其 中 刷新 用 户 列表 过 程 被 窗口 初始 化 
事件 调用 用 于 初始 化 窗口 。【 确 定 】 按 钮 单 击 事件 用 于 检验 用 户 名 与 密码 是 否 正确 ， 当 输入 
正确 用 户 名 和 密码 后 ， 程 序 保存 了 该 用 户 的 所 有 信息 。 如 图 7-12 所 示 的 是 【确定 】 按 钮 的 单 
击 事件 过 程 流程 图 。 


统计 按钮 被 单 击 次 数 intClickCount 
获取 用 户 管理 工作 表示 行 记 录 行 号 intRowsCount 


退出 


图 7-11 系统 登录 窗口 图 7-12 【确定 】 按 钮 单 击 事件 过 程 流程 图 
登录 窗口 的 详细 代码 解释 如 下 : 


Private Sub UserForm_lnitialize() 
' 在 窗口 初始 化 时 ， 重 置 用 户 名 列表 
刷新 用 户 名 列表 

End Sub 
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办 公 应 用 非 党 之 多 
Excel VBA 应 用 开发 经 典 案例 


Private Sub 确定 _Click() 
Dim intRowsCount As Integer, i As Integer 


Static intClickCount As Integer 


' 该 变量 记录 单 击 确定 按钮 次 数 


intClickCount = intClickCount + 1 
intRowsCount = 用 户 管理 .Range("A" & Rows.Count).End(xIUp).Row 
' 循 环 检测 用 户 管理 表 中 的 用 户 资料 ， 当 找到 对 应 用 户 后 ， 将 用 户 信息 保存 倒 登录 用 户 公共 变量 中 
Fori= 2 To intRowsCount 
lf 用 户 管理 .Range("A" & i) = 用 户 名 .Text And 用 户 管理 .Range("B" & i) = 用 户 密码 .Text Then 
With 登录 用 户 


.用 户 名 = 用 户 管理 .Range("A" & i) 

.密码 = 用 户 管理 .Range("A" & i) 

. 供 货 商 资料 建立 = 用 户 管理 .Range("C" & i) 
. 供 货 商 资料 查询 = 用 户 管理 .Range("D" & i) 
.商品 资料 建立 = 用 户 管理 .Range("E" & i) 
.商品 资料 查询 = 用 户 管理 .Range("F" & i) 


货 = 用 户 管理 .Range("G"&i) 


.进货 查询 = 用 户 管理 .Range("H" &i) 
.销售 = 用 户 管理 .Range(""&i) 

.销售 查询 = 用 户 管理 .Range("J" & i) 
.销售 分 析 = 用 户 管理 .Range("K" & i) 
.库存 = 用 户 管理 .Range("L" & i) 

.库存 查询 = 用 户 管理 .Range("M" & i) 
.管理 用 户 = 用 户 管理 .Range("N" &1i) 


End With 
Unload Me 
Exit Sub 


End 上 
Next 


' 当 输入 用 户 名 或 密码 错误 时 ， 提 示 错 误 次 数 。 当 错误 3 次 后 ， 退 出 系统 
If intClickCount < 3 Then 

MsgBox "用 户 不 存在 或 用 户 密码 输入 错误 ! 已 经 输入 " & intClickCount & "次 ， 
vbOKOnly + vblnformation 


Else 


ThisWorkbook.Close 


End If 
End Sub 


Private Sub 退出 _Click() 


Unload Me 
End Sub 


Sub 刷新 用 户 名 列表 () 
Dim intRowsCount As Integer, i As Integer 
intRowsCount = 用 户 管理 .Range("A" & Rows.Count).End(xIUp).Row 
Me. 用 户 名 .Clear ' 清 空 用 户 名 组 合 框 
' 重 置 用 户 名 组 合 框 项 目 
Fori= 2 To intRowsCount 
Me. 用 户 名 .Addltem 用 户 管理 .Range("A" & i) 


Next 
End Sub 


你 只 能 尝试 3 次 "， 


ff 
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7.4.3 修改 用 户 名 功能 设计 


修改 用 户 名 和 修改 密码 都 使 用 了 一 个 独立 的 窗口 。 修 改 用 户 名 时 ， 需 要 旧 用 户 名 、 用 户 
密码 、 新 用 户 名 方 可 完成 修改 工作 。 修 改 用户 名 的 窗 体 界面 如 图 7-13 所 示 。 当 前 用 户 如 果 有 
管理 用 户 的 权限 时 ， 可 以 设置 原 用 户 名 ， 否 则 不 能 修改 原 用 户 名 文本 框 中 的 内 容 。 

窗口 中 一 共 包 含 了 3 个 事件 过 程 的 代码 。 这 3 个 过 程 分 别 是 窗口 初始 化 事件 过 程 、【 确 
定 】 按 钮 单 击 事件 过 程 和 【取消 】 按 钮 单 击 事件 过 程 。3 个 事件 过 程 中 【确定 】 按 钮 单 击 事件 
过 程 稍 显 复 杂 ， 这 里 对 该 过 程 做 详细 介绍 。 单 击 【 确 定 】 按 钮 时 ， 程 序 需要 检测 输入 的 用 户 
名 是 否 存在 以 及 密码 是 否 正 确 。 当 在 用 户 管理 表 中 找到 该 用 户 并 且 密码 正确 时 ， 修 改 该 用 户 
的 用 户 名 为 新 用 户 名 即 可 。 如 图 7-14 所 示 的 是 该 过 程 的 流程 图 。 


ee 


于 等 于 用 户 管理 表 末 行 记录 行 避 7 一- 一 加 
一 用户 管 理 表 i 行 记录 是 否 与 输入 用 户 一 致 ? 
修改 用 户 名 并 保存 工作 短 
提示 未 找到 用 户 或 密码 错误 | 


图 7-13 修改 用 户 名 图 7-14 【确定 】 按 钮 单 击 事件 过 程 流 程 图 
该 窗 体 的 代码 仅 包 含 两 个 按钮 的 单 击 事件 代码 。 详 细 代 码 解释 如 下 : 


Private Sub UserForm_lnitialize() 
窗口 初始 化 时 ， 检 测 登 录用 户 是 否 有 管理 用 户 权限 ， 当 没有 管理 权限 时 ， 只 能 修改 自己 的 名 称 
lf 登录 用 户 .管理 用 户 = False Then 
原 用 户 名 .Text = 登录 用 户 .用 户 名 
原 用 户 名 .Enabled = False 
End If 
End Sub 


EE 
mp: | 
有 PS: [站 
E22 E39 


[Cae] mw | 


Private Sub 确定 _Click() 
On Error GoTo errorhandle 
Dim noExist As Boolean 
' 在 用 户 管理 表 中 逐个 检测 用 户 ， 当 有 匹配 用 户 时 ， 修 改 该 用 户 名 并 保存 工作 簿 
Fori= 2 To 用 户 管理 .Range("A65536").End(xIUp).Row 
lf 用 户 管理 .Range("A" & i).Text = 原 用 户 名 .Text And 用 户 管理 .Range("B" & i).Text = 密码 
.Text Then 
用 户 管理 .Range("A" &i) = 新 用 户 名 .Text 


Us 


办公 应 用 莫 内 - 迄 禾 
Excel VBA 应 用 开发 经 典 案例 


MsgBox "用 户 名 修改 成 功 ! 请 记 好 您 的 新 用 户 名 ! "，_ 
vblnformation, "用 户 名 修改 成 功 " 
Unload 修改 用 户 名 
' 保 存 工作 简 
ThisWorkbook.Save 
Exit Sub 
End If 
Next 
MsgBox "没有 用 户 名 " & 原 用 户 名 .Text & "或 密码 错误 ! ", vbCritical, "警告 
Unload 修改 用 户 名 
End Sub 


Private Sub 取消 _Click() 


Unload 修改 用 户 名 
End Sub 


7.4.4 ”修改 密码 功能 设计 


修改 密码 时 ， 需 要 用 户 名 、 原 密码 和 新 密码 。 修 改 密码 的 窗 体 界面 如 图 7-15 所 示 。 该 窗 
口 和 修改 用 户 名 窗口 类 似 ， 代 码 也 包含 了 3 个 事件 过 程 。 其 中 【确定 】 按 钮 单 击 事件 过 程 稍 
显 复杂 ， 不 过 该 过 程 的 流程 和 修改 用 户 名 窗口 的 【确定 】 按 钮 单 击 事件 流程 大 体 一 致 。 如 网 


7-16 所 示 的 是 该 过 程 的 流程 图 。 


是 
一 一 新 密码 与 确认 新 密码 一 致 ? 
是 


i=2 


否 


图 7-15 修改 密码 图 7-16 修改 密码 过 程 流程 
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该 窗 体 的 代码 详细 解释 如 下 : 
Private Sub UserForm_lnitialize() 
窗口 初始 化 时 ， 检 测 登录 用 户 是 否 有 管理 用 户 权限 ， 当 没有 管理 权限 时 ， 只 能 修改 自己 的 密码 
lf 登录 用 户 .管理 用 户 = False Then 
用 户 名 .Text = 登录 用 户 . 用 户 名 
用 户 名 .Enabled = False 
End If 
End Sub 


Private Sub CommandButton1_Click() 

On Error GoTo errorhandle 

Dim noExist As Boolean 

' 当 密码 长 度 少 于 5 上 时， 提示 重 新 设置 密码 ， 密 码 长 度 不 能 少 于 5 

lf Len( 新 密码 .Text) < 5 Then 
MsgBox "为 安全 起 见 ， 密 码 不 能 小 于 5 位 ! " vbCritical, "注意 ” 
新 密码 .Text = 
确认 新 密码 .Text = 
新 密码 .SetFocus 
Exit Sub 


Elself 新 密码 .Text <> 确认 新 密码 .Text Then ”' 当 新 密码 与 确认 密码 不 一 致 时 ， 提 示 重 新 设置 密码 


MsgBox "两 次 输入 的 密码 不 一 致 !'", vbCritical, "警告 " 
新 密码 .Text = " 
确认 新 密码 .Text = 
Exit Sub 
End If 
' 在 用 户 管理 表 中 逐个 对 照 ， 当 有 匹配 用 户 时 ， 修 改 该 用 户 的 密码 
Fori= 2To 用 户 管理 .Range("A65536").End(xIUp).Row 
lf 用户 管理 .Range("A" & i).Text = 用 户 名 .Text Then 
用 户 管理 .Range("B" & i) = 新 密码 .Text 
MsgBox "密码 修改 成 功 ! 请 记 好 您 的 新 密码 ", vblnformation, "修改 密码 " 


Unload 修改 密码 
保存 工作 簿 
ThisWorkbook.Save 
Exit Sub 
End If 

Next 

MsgBox "没有 用 户 名 "& 用 户 名 .Text & ”!", vbCritical, "警告 " 

Unload 修改 密码 

End Sub 


Private Sub CommandButton2_Click() 
Unload 修改 密码 
End Sub 


7.4.5 用 户 权限 管理 设计 


系统 对 每 个 用 户 操作 系统 的 权限 进行 了 细 分 ， 分 别 包 括 供应 商 资料 、 商 品 资料 、 进 货 、 


人 


销售 、 库 存 的 查询 和 修改 权限 以 及 用 户 管理 的 权限 。 这 些 权限 的 设置 都 保存 在 了 用 户 名 密码 


表 


了 4 个 事件 过 程 ， 分 别 是 窗 
击 事件 过 程 、 


件 过 程 。 


需要 赋值 的 项 目 比较 多 ， 因 而 其 中 部 分 过 程 占用 了 比较 多 


这 些 事件 代码 都 不 复杂 ， 主 要 完成 


篇 幅 。 以 下 不 再 给 出 这 些 过 程 的 流程 图 。 
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该 窗 体 的 详细 代码 解释 如 下 : 
Public 行 号 As Integer 
Private Sub UserForm_lnitialize() 


Dim intRowsCount As Integer, i As Integer 
Application.EnableEvents = False 


intRowsCount = 用 户 管理 .Range("A" & Rows.Count).End(xlUp).Row 


Fori= 2 To intRowsCount 

用 户 列表 .Addltem 用 户 管理 .Range("A" & i) 
Next 
用 户 列表 .Listndex = 0 
Application.EnableEvents = True 
End Sub 


Private Sub 关闭 _Click() 
Unload Me 
End Sub 


Private Sub 确定 _Click() 

With 用 户 管理 
.Range("C" & 行 号 ) = 供 货 商 资料 建立 .Value 
.Range("D" & 行 号 ) = 供 货 商 资料 查询 .Value 
.Range("E" & 行 号 ) = 商品 资料 建立 .Value 
.Range("F" & 行 号 ) = 商品 资料 查询 .Value 
.Range("G" & 行 号 ) = 进货 .Value 
.Range("H" & 行 号 ) = 进货 查询 .Value 
.Range("I" & 行 号 ) = 销售 .Value 
.Range("J" & 行 号 ) = 销售 查询 .Value 
.Range("K" & 行 号 ) = 销售 分 析 .Value 
.Range("L" & 行 号 ) = 库存 .Value 
.Range("M" & 行 号 ) = 库存 查询 .Value 
.Range("N" & 行 号 ) = 管理 用 户 .Value 

End With 

Unload Me 

End Sub 


Private Sub 用 户 列 表 _change() 
Dim intRowsCount As Integer, i As Integer 


- 些 赋值 操作 ， 由 于 


ph。 权 限 设置 的 窗 体 界面 如 图 7-17 所 示 。 该 窗口 一 共 包含 
初始 化 过 程 、【 确 定 】 按 钮 单 
【关闭 】 按 钮 单 击 事件 过 程 和 用 户 列表 改变 事 


的 


划 


图 7-17 用 户 权限 管理 


获取 用 户 管理 末 条 记录 行 号 
"循环 用 户 管理 所 有 用 户 记录 
为 用 户 列表 添加 项 目 


"设置 用 户 列表 默认 选 定 项 


"关闭 窗口 


"设置 用 户 供 货 商 资料 建立 权限 
"设置 用 户 供 货 商 资 料 查 询 权 限 
"设置 用 户 商品 资料 建立 权限 
"设置 用 户 商品 资料 查询 权限 
"设置 用 户 进货 权限 
"设置 用 户 进货 查询 权限 
"设置 用 户 销售 权限 
"设置 用 户 销售 查询 权限 
"设置 用 户 销售 分 析 权限 
"设置 用 户 库存 权限 
"设置 用 户 库存 查询 权限 
"设置 管理 用 户 权限 


-/ 
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intRowsCount = 用 户 管理 .Range("A" & Rows.Count).End(xlUp).Row ”获取 用 户 管理 末 条 记录 行 号 


Fori= 2 To intRowsCount "循环 用 户 管理 所 有 用 户 记录 
lf 用 户 管理 .Range("A" & i) = 用 户 列表 .Text Then ' 检 测 用 户 管理 表 第 i 个 用 户 名 是 否 与 选 
定 用 户 一 致 
With 用 户 管理 


供 货 商 资料 建立 .Value = CBool(.Range("C" & i)) ' 设 置 供 货 商 资料 建立 单 选 按 钮 
供 货 商 资料 查询 .Value = CBool(.Range("D" & i)) “设置 供 货 商 资料 查询 单 选 按钮 
商品 资料 建立 .Value = CBool(.Range("E" & i)) “设置 商品 资料 建立 单 选 按钮 
商品 资料 查询 .Value = CBool(.Range("F" & i)) ““' 设 置 商品 资料 查询 单 选 按钮 


进货 .Value = CBool(.Range("G" & i) "设置 进货 单 选 按钮 
进货 查询 .Value = CBool(.Range("H" & 1i)) "设置 进货 查询 单 选 按钮 
销售 .Value = CBool(.Range("l"& i)) "设置 销售 单 选 按钮 
销售 查询 .Value = CBool(.Range("J" & i)) "设置 销售 查询 单 选 按钮 
销售 分 析 .Value = CBool(.Range("K" &i) "设置 销售 分 析 单 选 按钮 
库存 .Value = CBool(.Range("L" &1i)) "设置 库存 单 选 按钮 
库存 查询 .Value = CBool(.Range("M" & i) "设置 库存 查询 单 选 按钮 
管理 用 户 .Value = CBool(.Range("N" & i) "设置 管理 用 户 单 选 按钮 
End With 
Exit Sub 
End ff 
供 货 商 资料 建立 .Value = False "取消 供 货 商 资料 单 选 按钮 选 定 
供 货 商 资料 查询 .Value = False "取消 供 货 商 资料 查询 单 选 按钮 选 定 
商品 资料 建立 .Value = False "取消 商品 资料 建立 单 选 按钮 选 定 
商品 资料 查询 .Value = False "取消 商品 资料 查询 单 选 按钮 选 定 
进货 .Value = False "取消 进货 单 选 按钮 选 定 
进货 查询 .Value = False "取消 近乎 偶 查 询 单 选 按钮 选 定 
销售 .Value = False "取消 销售 单 选 按钮 选 定 
销售 查询 .Value = False "取消 销售 查询 单 选 按钮 选 定 
销售 分 析 .Value = False "取消 销售 查询 单 选 按钮 选 定 
库存 .Value = False "取消 库存 单 选 按钮 选 定 
库存 查询 .Value = False "取消 库存 查询 单 选 按钮 选 定 
管理 用 户 .Value = False ' 取 消 管理 用 户 单 选 按钮 选 定 
Next 
End Sub 


7.5 供应 商 资料 管理 窗 体 设计 
7.5.1 ”供应 商 资料 管理 窗 体 界面 
每 一 个 供应 商 ， 可 能 有 的 资料 信息 包括 供应 商 名 称 、 通 讯 地 址 、 供 应 商 编码 、 邮 政 编码 、 
联系 电话 、 传 真 号 码 、 联 系 人 、 联 系 人 电话 、 联 系 人 Email 以 及 备注 项 目 。 对 于 供应 商 资料 ， 


通常 需要 完成 新 建 、 保 存 、 修 改 、 删 除 和 查询 工作 ， 这 些 都 可 以 通过 供应 商 资 料 管理 窗 体 完 
成 。 该 窗口 界面 如 图 7-18 所 示 。 
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EEEEEEE x|| 


| BF | HK | mm | sn | xn | 
一 供 备 南 基本 信息 

供血 商 名 称 [并 电器 

通讯 地 址 | 
[| 
联系 电话 Bess 传真 s 妈 [N11 

联系 人 EE 联系 人 电话 [tt 
联系 人 mail iE 


图 7-18 “供应 商 资料 管理 界面 
7.5.2 窗口 初始 化 与 关闭 事件 代码 设计 


窗口 初始 化 时 ， 需 要 初始 化 窗口 中 使 用 到 的 数组 myArray、 建 立 到 数据 库 的 链接 以 及 刷新 


窗口 显示 。 刷 新 窗口 通过 3 个 过 程 完 成 : 查询 供 货 商 信息 过 程 获取 供 货 商 信息 记录 集 ， 显 示 
供 货 商 信息 过 程 将 第 一 条 记录 数据 显示 在 窗口 的 各 个 文本 框 中 ，myListView 过 程 将 所 有 供 货 


商 信 息 显示 在 供 货 商 清 单 中 。 
以 下 是 该 窗 体 的 初始 化 过 程 与 关闭 事件 详细 代码 解释 : 


Dim myArray As Variant 
Dim cnn As New ADODB.Connection 
Dim rs As ADODB.Recordset 


Private Sub UserForm _lInitialize() 

Dim i As Integer 

Dim SQL As String 

myArray = Array(" 供 货 商 编码 ", " 供 货 商 名 称 ", "通讯 地 址 ", "邮政 编码 ", "联系 电话 ",， _ 
"传真 号 码 ", "联系 人 ", "联系 人 电话 ", "联系 人 Emai", "备注 ") 

' 建 立 与 数据 库 的 链接 

With cnn 
.ConnectionString = "Provider=microsoft.jet.oledb.4.0;" _ 
& "Data Source=" & ThisWorkbook.Path & "\ 进 销 存 数据 库 .mdb;”_ 
& "Jet Oledb:database password=123456;" 
.Open 

End With 

查询 供 货 商 信息 

显示 供 货 商 信息 

myListView 


mA 
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End Sub 


Private Sub 关闭 退出 _Click() 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
Unload 供 货 商 资料 管理 
End Sub 


7.5.3 保存 按钮 单 击 事件 代码 设计 


【保存 】 按 钮 用 于 将 用 户 新 建 的 供 货 商 资料 保存 到 数据 库 中 。 该 按钮 单 击 事件 过 程 首 先 
检测 用 户 是 否 输入 了 必要 的 供 货 商 数据 ， 然 后 确认 供 货 商 编号 与 数据 库 已 有 编号 是 否 重复 ， 
随后 程序 还 需要 确认 各 个 数据 的 长 度 不 超过 数据 库 允 许 长 度 ， 最 后 程序 将 供 货 商 资料 保存 到 
数据 库 中 并 刷新 窗口 显示 。 如 图 7-19 所 示 的 是 该 过 程 的 流程 图 。 


< 


轴 丰 从 休 上 输入 了 必要 的 供 货 商 娄 锋 7 一 
是 
否 
是 否 添 加 供 货 商 数据 故国 


一 一 一 供 货 商 编码 与 数据 库 中 编码 不 重复 7 
一 一 荫 个 数据 的 长 度 未 超过 数据 库 允许 长 度 站 


:让 


添加 新 供 货 商 数据 到 数据 库 
刷新 窗口 数据 显示 


退出 
图 7-19 【保存 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 保存 记录 _Click() 
Dim i As Integer 
"判断 是 否 在 窗 体 上 输入 了 必要 的 供 货 商 数据 
Fori= 0 To UBound(myArray) -1 
lf Me.Controls(myArray(i)).Name <> "备注 " Then 
If Me.Controls(myArray(i)).Value = "" Then 
MsgBox Me.Controls(myArray(i)).Name & "不 能 为 空 ! ", vbCritical 


Me.Controls(myArray(i)).SetFocus 
Exit Sub 
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End If 
End If 
Next 
' 首 先 判断 在 数据 库 中 是 否 存在 相同 的 供 货 商 编码 
Dim rsNum As New ADODB.Recordset 
SQL = "select 供 货 商 编码 from 供 货 商 信息 "_ 
& "where 供 货 商 编码 =" & 供 货 商 编码 .Value & "" 
rsNum.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
IfrsNum.BOF = False And rsNum.EOF = False Then 
MsgBox "在 数据 库 中 已 经 存在 有 编号 为 <" & 供 货 商 编码 .Value _ 
& "> 的 供 货 商 记录 ! " & vbCrLf _ 
& "请 重新 输入 供 货 商 编码 ! ", vbOKOnly + vbCritical 
Me. 供 货 商 编码 .Value = ” 
Me. 供 货 商 编码 .SetFocus 
GoTo hhh 
End If 
"准备 将 窗 体 上 的 数据 添加 到 数据 库 中 
SQL = "select * from 供 货 商 信息 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
判断 各 个 数据 的 长 度 是 否 超过 了 数据 库 允 许 的 长 度 
Fori= 0 To UBound(myArray) 
If Len(Me.Controls(myArray(i)).Value) > rs.Fields(i).DefinedSize Then 
MsgBox Me.Controls(myArray(i)).Name _ 
& "的 数据 长 度 已 经 超过 了 数据 库 规定 的 长 度 ! ", vbCritical 
Me.Controls(myArray(i)).Value = Left(Me.Controls(myArray(i)).Value，_ 
rs.Fields(i).DefinedSize) 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
Next 
If MsgBox(" 本 操作 将 添加 新 的 供 货 商 记录 !" & vbCrLf & "是 否 要 添加 ? "，_ 
vbQuestion + vbYesNo, "添加 记录 ") = vbNo Then Exit Sub 
"开始 添加 数据 
With rs 
.AddNew "添加 各 个 字段 的 数据 
Fori=0ToUBound(myArray) 
.Fields(i) = Me.Controls(myArray(i)). Value 
Next 
.Update 和 更 新 数据 表 
End With 
MsgBox "已 经 成 功 将 新 供 货 商 数据 添加 到 数据 库 中 !", vblnformation， "添加 记录 " 
"刷新 查询 和 显示 
查询 供 货 商 信息 
显示 供 货 商 信息 
myListView 
hhh: 
rsNum.Close 
Set rsNum = Nothing 
End Sub 
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7.5.4 ”新 建 按钮 单 击 事件 代码 设计 


【新 建 】 按 钮 用 于 重 设 窗口 中 所 有 输入 框 ， 便 于 用 户 输入 新 供应 商 信息 。 窗 口中 所 有 的 
输入 控件 的 名 称 在 窗口 初始 化 过 程 中 已 经 保存 ， 程 序 通过 一 个 For 循环 遍历 窗口 所 有 输入 控 
件 。 新 建 按钮 的 详细 代码 解释 如 下 : 

Private Sub 新 建 记录 _Click() 


Fori= 0 To UBound(myArray) "人 遍历 窗口 所 有 控件 
Me.Controls(myArray(i)).Value = ™ ' 置 空 输入 控件 
Next 
供 货 商 编码 .Enabled = True "设置 供应 商 编码 控件 可 用 
供 货 商 编码 .SetFocus "定位 输入 焦点 到 供应 商 编码 控件 
End Sub 


7.5.5 修改 按钮 单 击 事件 代码 设计 


【修改 】 按 钮 将 用 户 对 供应 商 资料 做 出 的 修改 操作 保存 到 数据 库 中。 在 确认 用 户 需要 修 
改 数据 后 ， 程 序 通 过 一 个 更 新 查询 SQL 语句 完成 修改 数据 库 记 录 操 作 ， 最 后 程序 通过 调用 查 
询 供 货 商 信息 、 显 示 供 货 商 信息 与 myListView 过 程 刷新 窗口 的 数据 显示 。 如 图 7-20 所 示 的 是 
该 过 程 的 流程 图 。 


设置 更 新 查询 字符 串 SQL 


查询 供 货 商 信息 记录 集 
显示 首 条 供 货 商 信息 


显示 所 有 供 货 商 信息 
图 7-20 【修改 】 按 钮 单 击 事件 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 修改 记录 _Click() 
上 MsgBox(" 本 操作 将 修改 编码 为 <" & 供 货 商 编码 .Value & "> 的 供 货 商 信息 记录 ! " _ 
& vbCrLf & "是 否 要 修改 ? "，_ 
vbQuestion + vbYesNo + vbDefaultButton2, "修改 记录 ") = vbNo Then Exit Sub 
"修改 更 新 记录 
SQL = "update 供 货 商 信息 set"_ 
& " 供 货 商 名 称 =" & 供 货 商 名 称 .Value &","”_ 


Excel VBA 应 用 开发 经 典 案例 


& "通讯 地 址 =" & 通讯 地 址 .Value &","”_ 
& "邮政 编码 =" & 邮政 编码 .Value &",”_ 
& "联系 电话 =" & 联系 电话 .Value& "”_ 
& "传真 号 码 =" & 传真 号 码 .-Value& "”_ 
& "联系 人 ="& 联系 人 .Value &""_ 
& "联系 人 电话 =" & 联系 人 电话 .Value& "”_ 
& "联系 人 Email=" & 联系 人 Email.Value &","”_ 
& "备注 =" & 备注 .Value &""_ 
& "where 供 货 商 编码 =" & 供 货 商 编码 .Value & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
MsgBox "已 经 成 功 将 编码 为 <" & 供 货 商 编码 .Value _ 
& "> 的 供 货 商 信息 记录 进行 修改 ! ", vblnformation，" 修 改 记 录 " 
' 刷 新 查询 和 显示 
查询 供 货 商 信息 
显示 供 货 商 信息 
myListView 


End Sub 


7:5:6 


删除 按钮 单 击 事件 代码 设计 


【删除 】 按 钮 用 于 删除 当前 显示 的 供应 商 资料 记录 ， 程 序 通过 一 个 删除 查询 在 数据 库 中 
完成 删除 操作 。 在 删除 操作 完成 之 后 ， 程 序 刷新 了 窗口 显示 的 记录 数据 。 以 下 是 该 过 程 的 详 
细 代码 解释 : 

Private Sub 删除 记录 _Click() 


If MsgBox(" 本 操作 将 删除 编码 为 <" & 供 货 商 编码 .Value & "> 的 供 货 商 信息 记录 ! "_ 
& vbCrLf & "是 否 要 删除 ? " _ 
vbQuestion + vbYesNo + vbDefaultButton2, "删除 记录 ") = vbNo Then Exit Sub 

SQL = "delete from 供 货 商 信息 where 供 货 商 编码 =" & 供 货 商 编码 .Value & "" 

Set rs = cnn.Execute(SQL) 

MsgBox "已 经 成 功 将 编码 为 <" & 供 货 商 编码 .Value & "> 的 供 货 商 信息 记录 删除 ! "，_ 
vblnformation, "删除 记录 " 

"刷新 查询 和 显示 

查询 供 货 商 信息 

显示 供 货 商 信息 

myListView 


End Sub 


了 


查询 按钮 单 击 事件 代码 设计 


在 供应 商 的 查询 操作 中 只 能 按照 供 货 商 编码 进行 查询 。 单 击 【查询 】 按 钮 后 ， 弹 出 一 个 
供 货 商 编码 输入 框 。 用 户 输入 完 供应 商 编码 后 ， 程 序 从 数据 库 中 获取 供 货 商 编码 为 用 户 输入 
结果 的 所 有 供 货 商 信息 ， 并 将 查询 到 的 记录 信息 显示 到 窗口 中 。 如 图 7-21 所 示 的 是 该 过 程 的 


流程 图 。 


Ah 
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获取 查询 供应 商 编码 myld 


是 


[其 询 供应 商 编码 为 myid 的 供 货 商 信息 ] 


显示 供应 商 编码 为 myId 的 供 货 商 信息 


图 7-21 【查询 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 查询 记录 _Click() 
Dim myld As String 
Dim SQL As String 
Dim i As Integer 
Fori= 0 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ™ 
Next 
myld = InputBox(" 请 输入 供 货 商 编码 :", " 供 货 商 查询 ") 
IfLen(Trim(myld)) = 0 Then 
MsgBox "没有 输入 供 货 商 编码 !", vbCritical, "警告 " 
Exit Sub 
End If 
SQL = "select * from 供 货 商 信息 where 供 货 商 编码 =" & myld & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
Ifrs.BOF And rs.EOF Then 
MsgBox "没有 编码 为 <" & myld & "> 的 供 货 商 信息 !", vbCritical, "查询 结果 " 
Else 
显示 供 货 商 信息 
供 货 商 编码 .Enabled = False 
End ff 
End Sub 


7.5.8 ListView 控件 项 目 单 击 事 件 代 码 设计 


用 户 在 ListView 控件 中 单 击 某 个 供应 商 项 目 后 ， 需 要 将 该 项 目的 所 有 数据 显示 到 窗口 上 
部 对 应 的 文本 框 中 。 程 序 首先 将 各 个 文本 框 的 值 清空 ， 然 后 通过 For 循环 ， 使 用 ListView 控 
件 的 ListItems 属性 定位 项 目 里 各 个 子 项 目 ， 并 把 这 些 子 项 的 数据 显示 到 窗口 上 面 对 应 的 文本 
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框 中 。 以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub ListView1_ltemClick(ByVal item As MSComctlLib.Listltem) 
On ErrorResume Next 
Dim i As Integer 
供 货 商 编码 .Enabled = False 
Fori= 0 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ™ 
Next 
Me.Controls(myArray(0)).Value = ListView1.Listltems(ltem.Index) 
Fori= 1 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ListView1.Listltems(ltem.Index).Subltems(i) 
Nexti 
End Sub 


7.5.9 ”查询 与 显示 供 货 商 信息 过 程 代码 设计 


查询 与 显示 供 货 商 信息 两 个 过 程 共 同 完成 查询 记录 集 并 将 记录 集 数据 显示 到 窗口 的 工 
作 。 查询 供 货 商 信息 首先 生成 -个 查询 供 货 商 信息 字符 串 ， 然 后 按照 该 查询 字符 串 打 开 记 录 
集 ， 从 而 获取 对 应 查询 信息 。 显 示 供 货 商 信息 过 程 使 用 在 查询 供 货 商 信息 过 程 中 获取 的 供 货 
商 信息 记录 集 ， 将 该 记录 集 首 条 记录 数据 写 入 到 窗口 的 各 个 对 应 文本 框 中 。 以 下 是 这 两 个 过 
程 的 详细 代码 解释 : 
Public Sub 查询 供 货 商 信息 () 
SQL = "select * from 供 货 商 信息 order by 供 货 商 编码 " 
Set rs = New ADODB.Recordset 


rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
End Sub 


Public Sub 显示 供 货 商 信息 () 
On ErrorResume Next 
Dim i As Integer 
新 建 记录 _Click 
' 显 示 第 一 个 供 货 商 信息 
rs.MoveFirst 
Fori=0ToUBound(myArray) 
If IsNull(rs.Fields(i)) Then 
Me.Controls(myArray(i)).Value =™ 
Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) 
End If 
Next 
End Sub 


7.5.10 ”myListView 过 程 代码 设计 


myListView 过 程 完 成 ListView 控件 的 显示 设置 以 及 标题 任务 , 然后 程序 将 rs 记录 集 的 所 
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有 记录 数据 显示 到 控件 上 。 如 图 7-22 所 示 的 是 该 过 程 流程 图 。 
清空 ListView 控 件 项 目 并 完成 显示 设置 


为 ListView 控 件 添加 标题 


图 7-22 myListView 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub myListView() 

On ErrorResume Next 

Dim i As Integer 

"设置 ListView 的 标题 

With ListView1 
.ColumnHeaders.Clear 
-Listltems.Clear 
.View = IlvwReport 
-FullRowSelect = True 
.Gridlines = True 
.Sorted = True 
.ColumnHeaders.Add , , myArray(0) 
Fori= 1 To UBound(myArray) 

.ColumnHeaders.Add ,, myArray(i) 

Next 
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"设置 ListView 的 各 行 数据 
i=0 
rs.MoveFirst 
Do While Not rs.EOF 
.Listltems.Add , , rs.Fields(0).Value 
Forj = 1 To rs.Fields.Count -1 
.Listltems(i + 1).Subltems(i) = rs.Fields(i).Value 
Next 
rs.MoveNext 
i=i+1 
Loop 
End With 
rs.MoveFirst 
供 货 商 数目 .Caption = "目前 数据 库 中 共有 ““" & i & ”条 供 货 商 资料 记录 " 
End Sub 


7.6 商品 资料 管理 窗 体 设计 


商品 资料 管理 窗口 用 于 完成 商品 资料 信息 的 管理 工作 ， 通 过 该 窗口 用 户 可 以 新 建 、 查 看 、 
编辑 、 删 除 商 品 基 本 信息 数据 。 进 货 模 块 与 销售 模块 都 将 会 使 用 到 该 部 分 建立 的 数据 。 


7.6.1 商品 资料 管理 窗口 界面 设计 


商品 资料 管理 窗口 和 供应 商 资料 管理 窗口 相似 ， 整 个 结构 上 大 体 一 致 ， 仅 仅 是 商品 资料 
管理 相关 的 项 目 不 一 样 而 已 。 商 品 资料 管理 需要 的 相关 资料 包括 商品 名 称 、 商 品 编码 、 商 品 
规格 、 计 量 单位 、 最 高 库存 、 最 低 库 存 以 及 备注 项 目 。 同 供应 商 资料 管理 模块 一 样 ， 该 模块 
也 需要 完成 新 建 、 保 存 、 修 改 和 删除 操作 。 该 窗口 的 界面 如 图 7-23 所 示 。 
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商品 名 称 | 入 尔 全 油 

aM Fnoc00s ，，，， Di 
Ee Ed 
IE 让 下 

备注 

FEE 

商品 加 码 [商号 名 座 ”| 商品 于 
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图 7-23 商品 资料 管理 界面 


Ah 
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7.6.2 ”窗口 初始 化 与 关闭 事件 代码 设计 


窗口 初始 化 时 ， 需 要 初始 化 窗口 中 使 用 到 的 数组 myArray、 建 立 到 数据 库 的 链接 以 及 刷新 
窗口 显示 。 刷 新 窗口 通过 3 个 过 程 完 成 : 查询 商品 信息 过 程 获取 商品 信息 记录 集 ， 显 示 商 品 
信息 过 程 将 第 一 条 记录 数据 显示 在 窗口 的 各 个 文本 框 中 ，myListView 过 程 将 所 有 商品 信息 显 
示 在 商品 信息 清单 中 。 

以 下 是 该 窗 体 的 初始 化 过 程 与 关闭 事件 详细 代码 解释 : 

Dim myArray As Variant 


Dim cnn As New ADODB.Connection 
Dim rs As ADODB.Recordset 


Private Sub UserForm_lnitialize() 
Dim i As Integer 
Dim SQL As String 
myArray = Array(" 商 品 编码 ", "商品 名 称 " "商品 规格 " "计量 单位 ，_ 
"最 高 库存 ", "最 低 库 存 ", "备注 ") 
' 建 立 与 数据 库 的 连接 
With cnn 
.ConnectionString = "Provider=microsoft.jet.oledb.4.0;” _ 
& "Data Source=" & ThisWorkbook.Path & " 进 销 存 数据 库 .mdb;"”_ 
& "Jet Oledb:database password=123456;" 
.Open 
End With 
查询 商品 信息 
显示 商品 信息 
myListView 
End Sub 


Private Sub 关闭 退出 _Click() 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
Unload 商品 资料 管理 
End Sub 


7.6.3 ”保存 按钮 单 击 事件 代码 设计 


【保存 】 按 钮 用 于 将 用 户 新 建 的 商品 资料 保存 到 数据 库 中 。 该 按钮 单 击 事件 过 程 首先 检 
测 用 户 是 否 输入 了 必要 的 商品 数据 ， 然 后 确认 商品 编号 与 数据 库 已 有 编号 是 否 重复 ， 随 后 程 
序 还 需要 确认 各 个 数据 的 长 度 不 超过 数据 库 允 许 长 度 ， 最 后 程序 将 商品 资料 保存 到 数据 库 中 
并 刷新 窗口 显示 。 如 图 7-24 所 示 的 是 该 过 程 的 流程 图 。 


2I0 


是 天 在 窗 休 上 输入 了 必要 的 商品 站 所 7 可 
否 
是 否 在 添加 商品 数据 
两 避 坑 码 与 数据 库 中 编码 不 重 先 | 


一 各 个 数据 的 长 度 未 超过 数据 库 允 许 长 度 


添加 新 商品 数据 到 数据 库 


刷新 窗口 数据 显示 


图 7-24 【保存 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub 保存 记录 _Click() 
On Error GoTo xxx 
Dim i As Integer 
"判断 是 否 在 窗 体 上 输入 了 必要 的 商品 数据 
Fori= 0 To UBound(myArray) -1 
lf Me.Controls(myArray(i)).Name <> "备注 " Then 
If Me.Controls(myArray(i)).Value = " Then 
MsgBox Me.Controls(myArray(i)).Name & "不 能 为 空 ! " vbCritical 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
End If 
Nexti 
上 MsgBox(" 本 操作 将 添加 新 的 商品 记录 !" & vbCrLf & "是 否 要 添加 ? "，_ 
vbQuestion + vbYesNo, "添加 记录 ") = vbNo Then Exit Sub 
' 首 先 判断 在 数据 库 中 是 否 存在 相同 的 商品 编码 
Dim rsNum As New ADODB.Recordset 
SQL = "select 商品 编码 from 商品 信息 where 商品 编码 =" & 商品 编码 .Value & "" 
rsNum.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
If rsNum.BOF = False And rsNum.EOF = False Then 
MsgBox "在 数据 库 中 已 经 存在 有 编号 为 <" & 商品 编码 .Value & "> 的 商品 记录 !" _ 
& vbCrLf & "请 重新 输入 商品 编码 ! ", vbOKOnly + vbCritical 
Me. 商 品 编码 .Value = " 
Me. 商 品 编码 .SetFocus 


Exit Sub 


End 上 
"准备 将 窗 体 上 的 数据 添加 到 数据 库 中 
SQL = "select* from 商品 信息 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
"判断 各 个 数据 的 长 度 是 否 超过 了 数据 库 允 许 的 长 度 
Fori=0ToUBound(myArray) 
上 fLen(Me.Controls(myArray(i)).Value) > rs.Fields(i).DefinedSize Then 
MsgBox Me.Controls(myArray(i)).Name _ 
& "的 数据 长 度 已 经 超过 了 数据 库 规定 的 长 度 ! ", vbCritical 
Me.Controls(myArray(i)).Value = Left(Me.Controls(myArray(i)).Value,_ 
rs.Fields(i).DefinedSize) 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
Nexti 
' 开 始 添加 数据 
With rs 
.AddNew 
Fori= 0 To UBound(myArray) 
.Fields(i) = Me.Controls(myArray(i)).Value 
Next i 
.Update 
End With 
MsgBox "已 经 成 功 将 新 商品 数据 添加 到 数据 库 中 !", vblnformation, "添加 记录 " 
' 刷 新 查询 和 显示 
Call 查询 商品 信息 
Call 显示 商品 信息 
Call myListView 
hhh: 
rsNum.Close 
Set rsNum = Nothing 
Exit Sub 
XXX: 
MsgBox Err.Description, vbCritical, "错误 " 
End Sub 


7.6.4 新 建 按钮 单 击 事件 代码 设计 


【新 建 】 按 钮 用 于 重 设 窗口 中 所 有 输入 框 ， 便 于 用 户 输入 新 商品 信息 。 窗 口中 所 有 的 输 
入 控件 的 名 称 在 窗口 初始 化 过 程 中 已 经 保存 ， 程 序 通过 一 个 For 循环 遍历 窗口 所 有 输入 控件 。 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 新 建 记录 _Click() 
Fori= 0 To UBound(myArray) 


Me.Controls(myArray(i)).Value = ™ 
Nexti 


7.6.5 ”修改 按钮 单 击 事件 代码 设计 


修改 按钮 用 于 将 用 户 对 商品 资料 做 出 的 修改 
操作 保存 到 数据 库 中 。 在 确认 用 户 需要 修改 数据 
后 , 程序 通过 一 个 更 新 查询 SQL 语句 完成 修改 数据 
库 记 录 操 作 ， 然 后 通过 调用 查询 商品 信息 、 显 示 商 
品 信息 与 myListView 过 程 刷新 窗口 的 数据 显示 。 如 
图 7-25 所 示 是 该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 详细 代码 解释 : 图 7-25 【修改 】 按 钮 单 击 事件 过 程 流程 图 

Private Sub 修改 记录 _Click() 


商品 编码 .Enabled = True 
商品 编码 .SetFocus 


End Sub 


查询 商品 信息 记录 集 
显示 首 条 商品 信息 


显示 所 有 商品 信息 


If MsgBox(" 本 操作 将 修改 编码 为 <" & 商品 编码 .Value & "> 的 商品 信息 记录 ! " _ 
& vbCrLf & "是 否 要 修改 ? "，_ 
vbQuestion + vbYesNo + vbDefaultButton2, "修改 记录 ") = vbNo Then Exit Sub 
"修改 更 新 记录 
SQL = "update 商品 信息 set"_ 
& "商品 名 称 =" & 商品 名 称 .Value& ""_ 
& "商品 规格 =" & 商品 规格 .Value& ""”_ 
& "计量 单位 =" & 计量 单位 .Value& "”_ 
& "最 高 库存 =" & 最 高 库存 .Value& ""”_ 
& "最 低 库存 =" & 最 低 库 存 .Value& ""”_ 
& "备注 =" & 备注 .Value&""_ 
& "Where 商品 编码 =" & 商品 编码 .Value & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
MsgBox "已 经 成 功 将 编码 为 <" & 商品 编码 .Value & "> 的 商品 信息 记录 进行 修改 ! "，_ 
vblnformation, "修改 记录 " 
' 刷 新 查询 和 显示 
Call 查询 商品 信息 
Call 显示 商品 信息 
Call myListView 


End Sub 


7.6.6 ”删除 按钮 单 击 事件 代码 设计 


【删除 】 按 钮 用 于 删除 当前 显示 的 商品 资料 记录 ， 程 序 通 过 一 个 删除 查询 在 数据 库 中 完 


成 删除 操作 。 在 删除 操作 完成 之 后 ， 程 序 刷新 了 窗口 显示 的 记录 数据 。 以 下 是 该 过 程 的 详细 
代码 解释 : 


ej 


Private Sub 删除 记录 _Click() 


lf MsgBox(" 本 操作 将 删除 编码 为 <" & 商品 编码 .Value & "> 的 商品 信息 记录 !" _ 
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& vbCrLf & "是 否 要 删除 ? "，_ 
vbQuestion + vbYesNo + vbDefaultButton2, "删除 记录 ") = vbNo Then Exit Sub 

SQL = "delete from 商品 信息 where 商品 编码 =" & 商品 编码 .Value & "" 

Set rs = cnn.Execute(SQL) 

MsgBox "已 经 成 功 将 编码 为 <" & 商品 编码 .Value & "> 的 商品 信息 记录 删除 ! "，_ 
vblnformation, "删除 记录 " 

' 刷 新 查询 和 显示 

Call 查询 商品 信息 

Call 显示 商品 信息 

Call myListView 

End Sub 


7.6.7 ”查询 按钮 单 击 事件 代码 设计 
在 商品 的 查询 操作 中 ， 只 能 按照 商品 编码 进行 查询 。 单 击 【查询 】 按 钮 后 ， 弹 出 一 个 商 


品 编码 输入 框 。 用 户 输入 完 商 品 编码 后 ， 程 序 从 数据 库 中 获取 商品 编码 为 用 户 所 输入 结果 的 
所 有 商品 信息 ， 并 将 查询 到 的 记录 信息 显示 到 窗口 中 。 如 图 7-26 所 示 是 该 过 程 的 流程 图 : 


获取 查询 商品 编码 myId 


查询 商品 编码 为 myId 的 商品 信息 
| 
显示 商品 编码 为 myId 的 商品 信息 
图 7-26 【查询 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 查询 记录 _Click() 
Dim myld As String 
Dim SQL As String 
Dim i As Integer 
Dim rsSerch As New ADODB.Recordset 
新 建 记录 _Click 
myld = InputBox(" 请 输入 商品 编码 :", "商品 查询 ") 
IfLen(Trim(myld)) = 0 Then 


SQL = "select * from 商品 信息 order by 商品 编码 " 
Else 
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SQL = "select * from 商品 信息 where 商品 编码 =" & myld & "" 
End 上 f 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
lfrs.BOF And rs.EOF Then 
MsgBox "没有 编码 为 <" & myld & "> 的 商品 信息 !", vbCritical, "查询 结果 " 
Else 
显示 商品 信息 
End 上 f 
End Sub 


7.6.8 ListView 控件 项 目 单 击 事件 代码 设计 


在 ListView 控件 中 单 击 某 个 项 目 后 ， 程 序 要 将 该 项 目的 所 有 数据 显示 到 窗口 上 部 对 应 的 
文本 框 中 ,程序 首先 将 各 个 文本 框 的 值 清空 ,然后 通过 For 循环 , 使 用 ListView 控件 的 ListItems 
属性 定位 项 目 中 的 各 个 子 项 目 ， 并 把 这 些 子 项 的 数据 显示 到 窗口 上 面 对 应 的 文本 框 中 。 以 下 
是 该 过 程 的 详细 代码 解释 : 

Private Sub ListView1_ltemClick(ByVal ltem As MSComctlLib.Listltem) 

On ErrorResume Next 
Dim i As Integer 
Call 新 建 记录 _Click 
Me.Controls(myArray(0)).Value = ListView1.Listltems(ltem.Index) 
Fori= 1 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ListView1.Listltems(ltem.Index).Subltems(i) 
Nexti 
End Sub 


7.6.9 查询 与 显示 商品 信息 过 程 代 码 设计 


查询 与 显示 商品 信息 两 个 过 程 共同 完成 查询 记录 集 并 将 记录 集 数据 显示 到 窗口 的 工作 。 
查询 商品 信息 过 程 先生 成 一 个 查询 商品 信息 字符 串 ， 然 后 按照 该 查询 字符 串 打开 记录 集 
而 获取 对 应 查询 信息 。 显 示 供 货 商 信息 过 程 使 用 在 查询 供 货 商 信 息 过 程 中 获取 的 供 货 商 信息 
记录 集 ， 将 该 记录 集 首 条 记录 数据 写 入 到 窗口 的 各 个 对 应 文本 框 中 。 以 下 是 这 两 个 过 程 的 详 
细 代 码 解释 : 
Public Sub 查询 商品 信息 () 
SQL = "select * from 商品 信息 order by 商品 编码 " 
Set rs = New ADODB.Recordset 


rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
End Sub 


Public Sub 显示 商品 信息 () 
On ErrorResume Next 
Dim i As Integer 
Call 新 建 记 录 _Click 
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' 显 示 第 一 个 商品 信息 
rs.MoveFirst 
Fori= 0 To UBound(myArray) 
If IsNull(rs.Fields(i)) Then 
Me.Controls(myArray(i)).Value = ™ 
Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) 
End If 
Next 
End Sub 


7.6.10 ”myListView 过 程 代码 设计 


myListView 过 程 完 成 ListView 控件 的 显示 设置 以 及 标题 任务 , 然后 将 记录 和 集 rs 的 所 有 记 
录 数 据 显示 到 控件 上 。 如 图 7-27 所 示 是 该 过 程 的 流程 图 。 


清空 ListView 控 件 项 目 并 完成 显示 设置 


为 ListView 控 件 添加 标题 


记录 集 下 一 条 记录 


图 7-27 myListView 过 程 流程 图 
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以 下 是 该 过 程 的 详细 代码 解释 


Private Sub myListView() 
On Error Resume Next 
Dim i As Integer 
' 设 置 ListView 的 标题 
With ListView1 
.ColumnHeaders.Clear 
.Listltems.Clear 
.View = IlvwReport 
.FullRowSelect = True 
.Gridlines = True 
.Sorted = True 
.ColumnHeaders.Add ,, myArray(0) 
Fori= 1 To UBound(myArray) 
.ColumnHeaders.Add ,, myArray(i) 
Nexti 
' 设 置 ListView 的 各 行 数 据 
i=0 
rs.MoveFirst 
Do While Not rs.EOF 
.Listltems.Add , , rs.Fields(0).Value 
Forj = 1To rs.Fields.Count -1 
.Listltems(i + 1).Subltems(i) = rs.Fields().Value 
Nextj 
rs.MoveNext 
i=i+1 
Loop 
End With 
rs.MoveFirst 
商品 数目 .Caption = "目前 数据 库 中 共有 "&i& ”条 商品 记录 " 
End Sub 


7.7 进货 资料 管理 窗 体 设计 


【进货 管理 】 窗 口 主要 完成 进货 、 进 货 查 询 和 导出 等 操作 。 进 货 操作 通过 【进货 资料 管 
理 】 窗 体 实现 。 进 货 查 询 和 导出 通过 【资料 查询 与 导出 】 窗 体 实现 。【 资 料 查询 与 导出 】 窗 
体 将 会 被 反复 使 用 在 所 有 的 资料 查询 与 导出 中 。【 资 料 查询 与 导出 】 窗 体 的 相关 内 容 将 集 
到 查询 与 导出 模块 一 起 介绍 。 


7.7.1 ”进货 资料 管理 窗 体 界面 设计 


进货 所 涉及 到 的 项 目 包括 商品 名 称 、 进 货 编码 、 商 品 编码 、 供 货 商 编码 、 商 品 规格 、 计 
量 单位 、 进 货 数量 、 进 货 单价 、 进 货 日 期 以 及 备注 项 目 。 该 窗 体 的 界面 如 图 7-28 所 示 。 
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EE > 
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图 7-28 进货 资料 管理 界面 
7.7.2 窗口 初始 化 与 关闭 事件 代码 设计 


窗口 初始 化 时 ， 需 要 初始 化 窗口 中 使 用 到 的 数组 myArray、 建 立 到 数据 库 的 链接 、 为 复合 
框 添加 项 目 以 及 刷新 窗口 显示 。 刷 新 窗口 通过 3 个 过 程 完成 ,查询 进 货 信息 过 程 获取 进货 信 
息 记录 集 ， 显 示 进 货 信息 过 程 将 第 一 条 记录 数据 显示 在 窗口 的 各 个 输入 控件 中 ，myListView 
过 程 将 所 有 进货 信息 显示 在 进货 信息 清单 中 。 该 过 程 的 流程 图 如 图 7-29 所 示 。 
| 建立 到 数据 库 的 链接 | 
[为 供 贷 商 复合 框 设置 项 目 | 


为 商品 复合 框 设置 项 目 


查询 进货 信息 


| 呈 于 进货 信息 | 
图 7-29 进货 资料 管理 窗口 初始 化 流程 图 
以 下 是 该 窗口 的 初始 化 过 程 与 关闭 事件 过 程 详细 代码 解释 : 


Dim myArray As Variant 
Dim cnn As New ADODB.Connection 
Dim rs As ADODB.Recordset 


Private Sub UserForm_lnitialize() 
Dim i As Integer 
Dim SQL As String 
Dim rsx As ADODB.Recordset 


| 
Eb, 办 公 应 用 非常 乞 煞 - 
弘 到 Excel VBA 应 用 开发 经 典 案例 站 


myArray = Array(" 进 货 编码 ", " 供 货 商 编码 ", "商品 编码 ", "商品 名称"，_ 
"商品 规格 ", "计量 单位 ", "进货 数量 ", "进货 单价 ", "进货 日 期 ", "备注 ") 
进货 日 期 .Value = Date 
"建立 与 数据 库 的 连接 
With cnn 
.ConnectionString = "Provider=microsoftjetoledb.4.0;"”_ 
& "Data Source=" & ThisWorkbook.Path & " 进 销 存 数据 库 .mdb;”_ 
& "Jet Oledb:database password=123456;" 
.Open 
End With 
' 为 供 货 商 编码 复合 框 设置 项 目 
SQL = "select 供 货 商 编码 from 供 货 商 信息 order by 供 货 商 编码 " 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset adLockOptimistic 
With 供 货 商 编码 
.Clear 
Do While Not rsx.EOF 
.Addltem rsx! 供 货 商 编码 
rsx.MoveNext 
Loop 
End With 
On Error Resume Next 
供 货 商 编码 .Listindex = 0 
On Error GoTo 0 
为 商品 编码 复合 框 设置 项 目 
SQL = "select 商品 编码 from 商品 信息 order by 商品 编码 " 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
With 商品 编码 
.Clear 
Do While Not rsx.EOF 
.Addltem rsx! 商 品 编码 
rsx.MoveNext 
Loop 
End With 
On Error Resume Next 
商品 编码 .ListiIndex = 0 
On Error GoTo 0 
' 查 询 并 在 窗 体 上 显示 数据 
查询 进货 信息 
显示 进货 信息 
myListView 
End Sub 


7.7.3 保存 按钮 单 击 事件 代码 设计 


【保存 】 按 钮 用 于 将 用 户 新 建 的 进货 资料 保存 到 数据 库 中 。 该 按钮 单 击 


由 
宣 
HH 
™ 
中 
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测 用 户 是 否 输入 了 必要 的 进货 数据 ， 然 后 确认 进货 编号 与 数据 库 已 有 编号 是 否 重复 ， 随 后 程 
序 还 需要 确认 各 个 数据 的 长 度 不 超过 数据 库 允 许 长 度 ， 最 后 程序 将 商品 资料 保存 到 数据 库 中 
并 刷新 窗口 显示 。 如 图 7-30 所 示 的 是 该 过 程 的 流程 图 。 


一 是否 在 窗 体 上 输入 了 必要 的 商品 数据 


是 否 在 添加 商品 数据 ? | 
商品 编码 与 数据 库 中 编码 不 重复 ? 
一 一 务 个 数据 的 长 度 未 超过 数据 库 允许 长 度 7 一 一 


添加 新 商品 数据 到 数据 库 
刷新 窗口 数据 显示 


香 


图 7-30 【保存 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 保存 记录 _Click() 
Dim i As Integer 
"判断 是 否 在 窗 体 上 输入 了 必要 的 进货 数据 
Fori=0ToUBound(myArray) -1 
上 Me.Controls(myArray(i)).Name <> "备注 " Then 
If Me.Controls(myArray(i)).Value = " Then 
MsgBox Me.Controls(myArray(i)).Name & "不 能 为 空 ! " vbCritical 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
End If 
Nexti 
If MsgBox(" 本 操作 将 添加 新 的 进货 记录 !" & vbCrLf & "是 否 要 添加 ? "，_ 
vbQuestion + vbYesNo, "添加 记录 ") = vbNo Then Exit Sub 
' 首 先 判断 在 数据 库 中 是 否 存在 相同 的 进货 编码 
Dim rsNum As New ADODB.Recordset 
SQL = "select 进货 编码 from 进货 信息 where 进货 编码 =" & 进货 编码 .Value & "" 
rsNum.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
IfrsNum.BOF = False And rsNum.EOF = False Then 
MsgBox "在 数据 库 中 已 经 存在 有 编号 为 <" & 进货 编码 .Value & "> 的 进货 记录 ! "_ 
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& vbCrLf & "请 重新 输入 进货 编码 ! ", vbOKOnly + vbCritical 
Me. 进 货 编码 .Value = " 
Me. 进 货 编码 .SetFocus 
GoTohhh 
End 上 f 
'--- 准 备 将 窗 体 上 的 数据 添加 到 数据 库 中 ---- 
SQL = "select * from 进货 信息 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
判断 各 个 数据 的 长 度 是 否 超过 了 数据 库 允 许 的 长 度 
Fori= 0 To UBound(myArray) 
If Len(Me.Controls(myArray(i)).Value) > rs.Fields(i).DefinedSize Then 
MsgBox Me.Controls(myArray(i)).Name _ 
& "的 数据 长 度 已 经 超过 了 数据 库 规定 的 长 度 ! ", vbCritical 
Me.Controls(myArray(i)). Value = Left(Me.Controls(myArray(i)).Value, _ 
rs.Fields(i).DefinedSize) 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
Nexti 
"开始 添加 数据 
With rs 
.AddNew 
Fori=0ToUBound(myArray) 
.Fields(i) = Me.Controls(myArray(i)).Value 
Nexti 
.Update 
End With 
MsgBox "已 经 成 功 将 新 进货 数据 添加 到 数据 库 中 !", vblnformation, "添加 记录 " 
' 刷 新 查询 和 显示 
查询 进货 信息 
显示 进货 信息 
myListView 
hhh: 
rsNum.Close 
Set rsNum = Nothing 
End Sub 


7.7.4 ”进货 数量 文本 框 事件 代码 设计 


对 于 每 一 个 商品 都 存在 一 个 最 大 与 最 小 库存 量 。 在 进货 数量 文本 框 中 输入 进货 数量 时 ， 
程序 需要 统计 剩余 库存 ， 将 该 数据 加 上 进货 数 获取 进货 后 库存 数 。 如 果 进 货 后 库存 数 仍 然 小 
于 最 小 库存 ， 用 户 需 要 加 大 进货 量 。 如 果 进货 后 库存 数 超过 最 大 库存 ， 用 户 需 要 减少 进货 妆 
这 些 功 能 都 是 通过 进货 数量 文本 框 事 件 实现 的 。 如 图 7-31 所 示 的 是 该 事件 过 程 的 流程 图 。 


进 销 存 


退出 
图 7-31 进货 数量 文本 框 事件 过 


以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub 进货 数量 _Exit(ByVal Cancel As MSForms.ReturnBoolean) 
On ErrorResume Next 
Dim rsx As ADODB.Recordset 
Dim SQL As String 
Dim Maxlnventory As Integer, Minlnventory As Integer 
Dim myOut As Integer, myln As Integer myNet As Integer 
"查询 该 商品 的 最 高 库存 和 最 低 库存 数据 
SQL = "select 最 高 库存 ,最 低 库存 from 商品 信息 "_ 
& "where 商品 编码 =" & 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
flsNull(rsx! 最 高 库存 ) Then 
Maxlnventory = 0 
Else 
Maxlnventory = rsx! 最 高 库存 
End If 
If lsNull(rsx! 最 低 库 存 ) Then 
Minlnventory = 0 
Else 
Minlnventory = rsx! 最 低 库存 
End If 
"统计 计算 该 商品 目前 的 库存 
SQL = "select sum( 进 货 数量 ) as aa from 进货 信息 where"_ 
& "商品 编码 =" & 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset adLockOptimistic 


;办公 应 用 非 党 之 禾 


Excel VBA 应 用 开发 经 典 案例 


If lsNull(rsx!aa) Then 
mylIn=0 
Else 
myln = rsxlaa 
End 上 
SQL = "select sum( 销 售 数量 ) as aa from 销售 信息 "”_ 
& "where 商品 编码 =" & 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
IflsNull(rsxlaa) Then 
myoOut =0 
Else 
myOut = rsxlaa 
End 上 
myNet = myln -myOut 
If Val( 进 货 数量 .Value) + myNet > Maxlnventory Then 
MsgBox "当前 该 商品 库存 为 "& myNet& "!"”_ 
& vbCrLf & "累计 进货 数量 已 经 超过 了 最 高 库存 ! ”_ 
& vbCrLf & "请 重新 输入 进货 数量 ", vbCritical, "进货 数量 " 
进货 数量 .Value = " 
进货 数量 .SetFocus 
Exit Sub 
Elself Val( 进 货 数 量 .Value) + myNet < Minlnventory Then 
MsgBox "当前 该 商品 库存 为 "& myNet &"!"_ 
& vbCrLf & "累计 进货 数量 不 足 ! " _ 
& vbCrLf & "请 重新 输入 进货 数量 ", vbCritical, "进货 数量 " 
进货 数量 .Value = 
进货 数量 .SetFocus 
Exit Sub 
End If 
End Sub 


7.7.5 商品 编码 复合 框 事件 代码 设计 


当 用 户 在 窗口 的 商品 编码 复合 框 中 选 定 了 某 个 项 目 后， 程序 将 会 刷新 窗口 中 有 关 该 商品 
信息 的 输入 框 〈《 其 中 包括 商品 名 称 、 商 品 规格 和 计量 单位 ) 。 为 了 保证 这 些 控件 的 数据 与 商 
品 编码 同步 ， 程 序 不 允许 用 户 编辑 这 些 控件 中 的 数据 。 以 下 是 该 过 程 的 详细 代码 解释 : 

Private Sub 商品 编码 _Change() 

On Error Resume Next 

Dim rsx As New ADODB.Recordset 

为 商品 名 称 复合 框 设置 项 目 

SQL = "select* from 商品 信息 where 商品 编码 =" & 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 

rsx.Open SQL, cnn, adOpenKeyset adLockOptimistic 

商品 名 称 = rsx! 商 品名 称 

商品 规格 = rsx! 商 品 规格 

计量 单位 = rsx! 计 量 单位 


ah 
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商品 名 称 .Enabled = False 
商品 规格 .Enabled = False 
计量 单位 .Enabled = False 
rsx.Close 
Set rsx = Nothing 

End Sub 


7.7.6 ”新 建 按钮 单 击 事件 代码 设计 


【新 建 】 按 钮 用 于 重 设 窗口 中 所 有 输入 框 ， 便 于 用 户 输入 新 进货 信息 。 窗 口中 所 有 的 输 
入 控件 的 名 称 在 窗口 初始 化 过 程 中 已 经 保存 ， 程 序 通过 一 个 For 循环 遍历 窗口 所 有 输入 控件 。 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 新 建 记录 _Click() 
Fori= 0 To UBound(myArray) 
lf Me.Controls(myArray(i)).Name <> "进货 日 期 " Then 
Me.Controls(myArray(i)).Value = ™" 
Else 
Me.Controls(myArray(i)).Value = Date 
End If 
Nexti 
进货 日 期 = Date 
进货 编码 .Enabled = True 
进货 编码 .SetFocus 
End Sub 


7.7.7 ”修改 按钮 单 击 事件 代码 设计 


【修改 】 按 钮 将 用 户 对 商品 资料 做 出 的 修改 操作 保存 到 数据 库 中 。 在 确认 用 户 需要 修改 
数据 后 ， 程 序 通过 一 个 更 新 查询 SQL 语句 完成 修改 数据 库 记录 操作 ， 然 后 通过 调用 查询 商品 信 
息 、 显 示 商 品 信息 与 myListView 过 程 刷新 窗口 的 数据 显示 。 如 图 7-32 所 示 是 该 过 程 的 流程 图 。 
否 


一 一 是 否 修改 商品 资料 


设置 更 新 查询 字符 串 SQL 


查询 进货 信息 记录 集 


显示 首 条 进货 信息 


显示 所 有 进货 信息 到 ListView 控 件 


图 7-32 【修改 】 按 钮 单 击 事件 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub 修改 记录 _Click() 
lf MsgBox(" 本 操作 将 修改 编码 为 <" & 进货 编码 .Value & "> 的 进货 信息 记录 !" _ 
& vbCrLf & "是 否 要 修改 ? "，_ 
vbQuestion + vbYesNo + vbDefaultButton2, "修改 记录 ") = vbNo Then Exit Sub 
' 一 -修改 更 新 进货 信息 记录 ---- 
SQL = "update 进货 信息 set"_ 
& "商品 编码 =" & 商品 编码 .Value &",”_ 
& "商品 编码 =" & 商品 编码 .Value& "”_ 
& "商品 名 称 =" & 商品 名 称 .Value &",”_ 
& "商品 规格 =" & 商品 规格 .Value &",”_ 
& "计量 单位 =" & 计量 单位 .Value& "”_ 
& "进货 数量 =" & 进货 数量 .Value & ""”_ 
& "进货 单价 =" & 进货 单价 .Value& ""_ 
& "进货 日 期 =" & 进货 日 期 .Value&"”_ 
& "备注 =" & 备注 .Value &""_ 
& "where 进货 编码 =" & 进货 编码 .Value & "" 
Set rs = New ADODB. Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
MsgBox "已 经 成 功 将 编码 为 <" & 进货 编码 .Value & "> 的 进货 信息 记录 进行 修改 ! "，_ 
vblnformation, "修改 记录 " 
' 刷 新 查询 和 显示 
查询 进货 信息 
myListView 
End Sub 


7.7.8 删除 按钮 单 击 事件 代码 设计 


【删除 】 按 钮 用 于 删除 当前 显示 的 商品 资料 记录 ， 程 序 通 过 一 个 删除 查询 在 数据 库 中 完 
成 删除 操作 。 在 删除 操作 完成 之 后 ， 程 序 刷 新 了 窗口 显示 的 记录 数据 。 以 下 是 该 过 程 的 详细 
代码 解释 : 


Private Sub 删除 记录 _Click() 
On Error Resume Next 
lf MsgBox(" 本 操作 将 删除 编码 为 <" & 进货 编码 .Value & "> 的 进货 信息 记录 ! "_ 
& vbCrLf & "是 否 要 删除 ? "，_ 
vbQuestion + vbYesNo + vbDefaultButton2, "删除 记录 ") = vbNo Then Exit Sub 
SQL = "delete from 进货 信息 where 进货 编码 =”& 进货 编码 .Value &"" 
Set rs = cnn.Execute(SQL) 
MsgBox "已 经 成 功 将 编码 为 <" & 进货 编码 .Value & "> 的 进货 信息 记录 删除 ! "，_ 
vblnformation, "删除 记录 " 
"刷新 查询 和 显示 
Call 查询 进货 信息 
Call 显示 进货 信息 
Call myListView 
End Sub 


i 
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7.7.9 查询 按钮 单 击 事件 代码 设计 


在 进货 信息 的 查询 操作 中 只 能 按照 进货 编码 进行 查询 。 单 击 【查询 】 按 钮 后 ， 弹 出 一 个 
进货 编码 输入 框 。 用 户 输入 完 进货 编码 后 ， 程 序 从 数据 库 中 获取 进货 编码 为 用 户 输入 结果 的 
所 有 进货 信息 ， 并 将 查询 到 的 记录 信息 显示 到 窗口 中 。 如 图 7-33 所 示 的 是 该 过 程 的 流程 图 。 


获取 查询 进货 编码 myId 


myId 是 否 合法 ? 


查询 进货 编码 为 myId 的 进货 信息 
记录 集 有 记录 ? 
显示 进货 编码 为 myId 的 进货 信息 | 


图 7-33 【查询 】 按 钮 单 击 事件 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 查询 记录 _Click() 
Dim myld As String 
Dim SQL As String 
Dim i As Integer 
Dim rsSerch As New ADODB.Recordset 
Call 新 建 记录 _Click 
myld = InputBox(" 请 输入 进货 编码 : " "进货 查询 ") 
IfLen(Trim(myld)) = 0 Then 
SQL = "select * from 进货 信息 order by 进货 编码 " 
End If 
SQL = "select * from 进货 信息 where 进货 编码 =" & myld & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
Ifrs.BOF And rs.EOF Then 
MsgBox "没有 编码 为 <" & myld & "> 的 进货 信息 !", vbCritical, "查询 结果 " 
Else 
Call 显示 进货 信息 
进货 编码 .Enabled = False 
End 上 f 
End Sub 


;办公 应 用 非 常 之 如- 


Excel VBA 应 用 开发 经 典 案例 


7.7.10 ”ListView 控件 项 目 单 击 事件 代码 设计 


用 户 在 ListView 控件 中 单 击 某 个 项 目 后 ， 程 序 要 将 该 项 目的 所 有 数据 显示 到 窗口 上 部 对 
应 的 文本 框 中 。 程 序 首先 将 各 个 文本 框 的 值 清空 ， 然 后 通过 For 循环 ， 使 用 ListView 控件 的 
ListItems 属性 定位 项 目 里 各 个 子 项 目 ， 并 把 这 些 子 项 目的 数据 显示 到 窗口 上 面 对 应 的 文本 杠 
中 。 以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub ListView1_ltemClick(ByVal ltem As MSComctlLib.Listltem) 
On Error Resume Next 
Dim i As Integer 
Call 新 建 记录 _Click 
进货 编码 .Enabled = False 
Me.Controls(myArray(0)).Value = ListView1.Listltems(ltem.Index) 
Fori= 1 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ListView1.Listltems(ltem.Index).Subltems(i) 
Nexti 
End Sub 


7.7.11 ”查询 与 显示 进货 信息 过 程 代 码 设计 


查询 与 显示 进货 信息 两 个 过 程 共同 完成 查询 记录 集 并 将 记录 集 数据 显示 到 窗口 的 工作 。 


查询 进货 信息 首先 生成 一 个 查询 进货 信息 字符 串 , 然后 按照 该 查询 字符 串 打 开 记 录 集 , 从 而 获 
取 对 应 查询 信息 。 显 示 进 货 信息 过 程 使 用 在 查询 进货 信息 过 程 中 获取 的 供 货 商 信息 记录 集 ， 将 


该 记录 集 首 条 记录 数据 写 入 到 窗口 的 各 个 对 应 文本 框 中 。 以 下 是 这 两 个 过 程 的 详细 代码 解释 : 
Public Sub 查询 进货 信息 () 
SQL = "select * from 进货 信息 order by 进货 编码 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
End Sub 


Public Sub 显示 进货 信息 () 
On ErrorResume Next 
Dim i As Integer 
Call 新 建 记录 _Click 
rs.MoveFirst 
Fori= 0 To UBound(myArray) 
If IsNull(rs.Fields(i)) Then 
Me.Controls(myArray(i)).Value = ™ 
Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) 
End If 
Nexti 
End Sub 


7.7.12 ”myListView 过 程 代码 设计 


myListView 过 程 完成 ListView 控件 的 显示 设置 以 及 标题 显示 任务 ， 然 后 程序 将 记录 集 rs 


第 7 章 进 销 存 


的 所 有 记录 数据 显示 到 控件 上 。 如 图 7-34 所 示 是 该 过 程 的 流程 图 。 


设置 ListView 控 件 显示 属性 
设置 ListView 控 件 标题 


Es 
是 
为 ListView 控 件 添加 项 目 
为 项 目 添加 子 项 目 


图 7-34 myListView 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub myListView() 
On Error Resume Next 
Dim i As Integer 
' 设 置 ListView 的 标题 
With ListView1 
.ColumnHeaders.Clear 
.Listltems.Clear 
.View = IlvwwReport 
.FullRowSelect = True 
.Gridlines = True 
.Sorted = True 
.ColumnHeaders.Add ,, myArray(0) 
Fori= 1 To UBound(myArray) 
.ColumnHeaders.Add ,, myArray(i) 
Next 
"设置 ListView 的 各 行 数据 
i=0 
rs.MoveFirst 
Do While Not rs.EOF 
.Listltems.Add , , rs.Fields(0).Value 
Forj = 1To rs.Fields.Count -1 


Ah 


AAA 


PEP7 


办 公 应 用 意 党 之 狗 
Excel VBA 应 用 开发 经 典 案例 


.Listltems(i + 1).Subltems(j) = rs.Fields(i).Value 
Next 
rs.MoveNext 
i=i+1 
Loop 
End With 
rs.MoveFirst 
进货 记录 .Caption = "目前 数据 库 中 共有 “" &i & ”条 进货 记录 " 
End Sub 


7.8 ”销售 资料 管理 窗 体 设计 


销售 管理 窗口 主要 完成 销售 、 销 售 查询 和 导出 。 两 个 功能 都 是 通过 独立 的 窗 体 来 实现 的 : 
销售 工作 通过 销售 资料 管理 窗 体 实 现 ， 销 售 查 询 和 导出 通过 资料 查询 与 导出 窗 体 实现 。 资 料 
查询 与 导出 窗 体 将 会 被 反复 使 用 在 所 有 的 资料 查询 与 导出 中 ， 其 相关 介绍 将 集中 到 查询 与 导 
出 模块 一 起 介绍 。 


7.8.1 销售 资料 管理 窗 体 界面 设计 


销售 所 涉及 到 的 项 目 包 括 商品 名 称 、 销 售 编码 、 商 品 编码 、 商 品 规格 、 计 量 单位 、 销 售 
数量 、 销 售 单价 、 销 售 日 期 以 及 备注 项 目 。 该 窗 体 的 界面 如 图 7-35 所 示 。 


过 
wm)| | 上 | 县 | | | 
销售 基本 信息 一 
商品 名 称 「 | 
销售 护 码 上 商品 二 码 |「 可 
商品 规格 「 计量 单位 |「 
销售 数量 | 销售 单价 |[ 
销售 日 期 2007-10-19 = 
备注 
| 销售 信息 清 间 
销售 蚁 码 | 商 避 病友 | 商品 和 和 | 商品 规格 | 计 重音 
划 


E 


图 7-35 销售 资料 管理 界面 


7.8.2 ”窗口 初始 化 与 关闭 事件 代码 设计 


窗口 初始 化 时 需要 初始 化 窗口 中 使 用 到 的 数组 myArray、 建 立 到 数据 库 的 链接 、 为 复合 框 


Ah 
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添加 项 目 以 及 刷新 窗口 显示 。 刷 新 窗口 通过 3 个 过 程 
完成 : 查询 销售 信息 过 程 获取 销售 信息 记录 集 ， 显 示 - 
销售 信息 过 程 将 第 一 条 记录 数据 显示 在 窗口 的 各 个 输 
入 控件 中 , myListView 过 程 将 所 有 销售 信息 显示 在 销 查询 销售 信息 
售 信息 清 青 单 中 。 该 过 程 的 流程 图 如 图 7-36 所 示 。 

以 下 是 该 窗 体 的 初始 化 过 程 与 关闭 事件 过 程 的 
详细 代码 解释 : 图 7-36 进货 资料 管理 窗口 初始 化 流程 图 

Dim myArray As Variant 


Dim cnn As New ADODB.Connection 
Dim rs As ADODB.Recordset 


显示 销售 信息 


Private Sub UserForm _lInitialize() 
Dim i As Integer 
Dim SQL As String 
Dim rsx As ADODB.Recordset 
myArray = Array(" 销 售 编码 ", "商品 编码 " "商品 名 称 " "商品 规格 "，_ 
"计量 单位 ", "销售 数量 ", "销售 单价 ", "销售 日 期 ", "备注 ") 
销售 日 期 .Value = Date 
' 建 立 与 数据 库 的 连接 
With cnn 
ec ng 有 = "Provider=microsoft.jet.oledb.4.0;" 
& "Data Source=" & ThisWorkbook.Path & " 进 销 存 数据 库 .mdb:" 
& "Jet Oledb:database password=123456;" 
.Open 
End With 
为 商品 编码 复合 框 设 置 项 目 
SQL = "select 商品 编码 from 商品 信息 order by 商品 编码 " 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
With 商品 编码 
.Clear 
Do While Not rsx.EOF 
.Addltem rsx! 商 品 编码 
rsx.MoveNext 
Loop 
End With 
rsx.Close 
Set rsx = Nothing 
' 查 询 并 在 窗 体 上 显示 数据 
查询 销售 信息 
显示 销售 信息 
myListView 
End Sub 


Private Sub 关闭 退出 _Click() 
cnn.Close 


办 公 应 用 意 几 之 禾 
Excel VBA 应 用 开发 经 典 案例 
Set rs = Nothing 

Set cnn = Nothing 


Unload 销售 资料 管理 
End Sub 


7.8.3 保存 按钮 单 击 事件 代码 设计 

【保存 】 按 钮 用 于 将 用 户 新 建 的 销售 商品 资料 保存 到 数据 库 中 。 该 按钮 单 击 事件 过 程 首 
先 检测 用 户 是 否 输入 了 必要 的 销售 数据 ， 然 后 确认 销售 编号 与 数据 库 已 有 编号 是 否 重复 ， 随 
后 程序 还 需要 确认 各 个 数据 的 长 度 不 超过 数据 库 允许 长 度 ， 最 后 程序 将 销售 资料 保存 到 数据 
库 中 并 刷新 窗口 显示 。 如 图 7-37 所 示 的 是 该 过 程 的 流程 图 。 


一 ”是 否 在 窗 体 上 输入 了 必要 的 销售 数据 ? 
否 
销售 编码 与 数据 库 中 编码 不 重复 ? 


一 一 各 个 数据 的 长 度 未 超过 数据 库 允 许 长 - 


添加 新 销售 数据 到 数据 库 
刷新 窗口 数据 显示 


退出 


图 7-37 【保存 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 保存 记录 _Click() 
Dim i As Integer 
"判断 是 否 在 窗 体 上 输入 了 必要 的 销售 数据 
Fori=0ToUBound(myArray) -1 
上 Me.Controls(myArray(i)).Name <> "备注 " Then 
If Me.Controls(myArray(i)). Value = " Then 
MsgBox Me.Controls(myArray(i)).Name & "不 能 为 空 ! ", vbCritical 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
End If 
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Next 
上 f MsgBox(" 本 操作 将 添加 新 的 销售 记录 ! " & vbCrLf & "是 否 要 添加 ? "，_ 
vbQuestion + vbYesNo, "添加 记录 ") = vbNo Then Exit Sub 
' 首 先 判断 在 数据 库 中 是 否 存在 相同 的 销售 编码 
Dim rsNum As New ADODB.Recordset 
SQL = "select 销售 编码 from 销售 信息 where 销售 编码 =" & 销售 编码 .Value & "" 
rsNum.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
IfrsNum.BOF = False And rsNum.EOF = False Then 
MsgBox "在 数据 库 中 已 经 存在 有 编号 为 <" & 销售 编码 .Value & "> 的 销售 记录 !" _ 
& vbCrLf & "请 重新 输入 销售 编码 ! " vbOKOnly + vbCritical 
Me. 销 售 编码 .Value = ” 
Me. 销 售 编码 .SetFocus 
GoTo hhh 
End If 
"准备 将 窗 体 上 的 数据 添加 到 数据 库 中 
SQL = "select * from 销售 信息 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
判断 各 个 数据 的 长 度 是 否 超过 了 数据 库 允 许 的 长 度 
Fori= 0 To UBound(myArray) 
If Len(Me.Controls(myArray(i)).Value) > rs.Fields(i).DefinedSize Then 
MsgBox Me.Controls(myArray(i)).Name _ 
& "的 数据 长 度 已 经 超过 了 数据 库 规定 的 长 度 ! ", vbCritical 
Me.Controls(myArray(i)).Value = Left(Me.Controls(myArray(i)).Value，_ 
rs.Fields(i).DefinedSize) 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
Nexti 
"开始 添加 数据 
With rs 
.AddNew 
Fori=0ToUBound(myArray) 
.Fields(i) = Me.Controls(myArray(i)).Value 
Nexti 
.Update 
End With 
MsgBox "已 经 成 功 将 新 销售 数据 添加 到 数据 库 中 !", vblnformation, "添加 记录 " 
"刷新 查询 和 显示 
查询 销售 信息 
显示 销售 信息 
myListView 
hhh: 
rsNum.Close 
Set rsNum = Nothing 
End Sub 


Pepi 


办 公 应 用 章 第 之 禾 


Excel VBA 应 用 开发 经 典 案例 


7.8.4 商品 编码 复合 框 事件 代码 设计 


当 用 户 在 窗口 的 商品 编码 复合 框 中 选 定 了 某 个 项 目 后 ， 程 序 将 会 刷新 窗口 中 有 关 该 商品 
信息 的 输入 框 。 这 些 输入 框 包括 商品 名 称 、 商 品 规格 和 计量 单位 。 为 了 保证 这 些 控件 的 数据 
与 商品 编码 同步 ， 程 序 不 允许 用 户 编辑 这 些 控件 中 的 数据 。 以 下 是 该 过 程 的 详细 代码 解释 : 

Private Sub 商品 编码 _Change() 


On Error Resume Next 

Dim rsx As New ADODB.Recordset 

为 商品 名 称 复合 框 设 置 项 目 

SQL = "select * from 商品 信息 where 商品 编码 =" & 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 

rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
商品 名 称 = rsx! 商 品名 称 

商品 规格 = rsx! 商 品 规格 

计量 单位 = rsx! 计 量 单位 

商品 名 称 .Enabled = False 

商品 规格 .Enabled = False 

计量 单位 .Enabled = False 

rsx.Close 

Set rsx = Nothing 


End Sub 


7.8.5 ”销售 数量 文本 框 事件 代码 设计 


在 用 户 确认 销售 数据 时 ， 程 序 需要 根据 库存 数据 判定 该 次 销售 操作 是 否 实现 。 程 序 首先 
从 数据 库 中 获取 该 商品 的 总 进货 量 ， 然 后 获取 该 商品 的 总 销售 量 ， 根 据 这 两 个 数据 获取 实际 
商品 库存 。 注 意 ， 用 户 输入 的 销售 商品 数量 不 能 超过 该 实际 商品 库存 。 如 图 7-38 所 示 是 该 过 
程 的 流程 图 。 


统计 计算 该 商品 总 进货 量 myIn 
统计 计算 该 商品 总 销售 量 myOut 
统计 该 商品 净 库 存 myNet 


图 7-38 ”销售 数量 文本 框 事件 代码 设计 
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以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 销售 数量 _Exit(ByVal Cancel As MSForms.ReturnBoolean) 
Dim rsx As ADODB.Recordset 
Dim SQL As String 
Dim myOut As Integer, myln As Integer, myNet As Integer 
' 统 计 计算 该 商品 目前 的 库存 
SQL = "select sum( 进 货 数量 ) as aa from 进货 信息 where 商品 编码 =" & 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
IflsNull(rsxlaa) Then 
myln =0 
Else 
myln = rsxlaa 
End 上 f 
SQL = "select sum( 销 售 数量 ) as aa from 销售 信息 where 商品 编码 =”& 商品 编码 .Value & "" 
Set rsx = New ADODB.Recordset 
rsx.Open SQL, cnn, adOpenKeyset adLockOptimistic 
IflsNull(rsxlaa) Then 
myoOut =0 
Else 
myOut = rsxlaa 
End If 
myNet = myln -myOut 
If Val( 销 售 数量 .Value) > myNet Then 
MsgBox "当前 该 商品 库存 为 "& myNet &"!"_ 
& vbCrLf & "销售 数量 已 经 超过 净 库 存量 ! "_ 
& vbCrLf & "请 重新 输入 销售 数量 ", vbCritical, "销售 数量 " 
销售 数量 .Value = " 
销售 数量 .SetFocus 
Exit Sub 
End ff 
End Sub 


7.8.6 ”新 建 按钮 单 击 事件 代码 设计 


【新 建 】 按 钮 用 于 重 设 窗口 中 的 所 有 输入 框 ， 便 于 用 户 输入 新 销售 信息 。 窗 口中 所 有 的 
输入 控件 名 称 在 窗口 初始 化 过 程 中 已 经 保存 ， 程 序 通过 一 个 For 循环 遍历 窗口 所 有 输入 控件 。 
除了 销售 日 期 文本 框 以 外 ， 其 他 所 有 输入 控件 都 需要 重 置 。 以 下 是 该 按钮 的 详细 代码 解释 : 

Private Sub 新 建 记录 _Click() 
Fori=0ToUBound(myArray) 
lf Me.Controls(myArray(i)).Name <> "销售 日 期 " Then 
Me.Controls(myArray(i)). Value = ” 
End If 
Next 
销售 日 期 = Date 
销售 编码 .Enabled = True 
销售 编码 .SetFocus 
End Sub 


办公 应 用 非 常 之 名 


Excel VBA 应 用 开发 经 典 案例 


7.8.7 修改 按钮 单 击 事件 代码 设计 


【修改 】 按 钮 将 用 户 对 销售 数据 做 出 的 修改 操作 保存 到 数据 库 中 。 在 确认 用 户 需要 修改 
数据 后 , 程序 通过 一 个 更 新 查询 SQL 语句 完成 修改 数据 库 记 录 操 作 , 通过 调用 查询 销售 信息 、 
显示 销售 信息 与 myListView 过 程 刷新 窗口 的 数据 显示 。 如 图 7-39 所 示 是 该 过 程 的 流程 图 。 


显示 所 有 销售 信息 到 ListView 控 件 


图 7-39 【修改 】 按 钮 单 击 事件 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 修改 记录 _Click() 
If MsgBox(" 本 操作 将 修改 编码 为 <" & 销售 编码 .Value & "> 的 销售 信息 记录 !" _ 
& vbCrLf & "是 否 要 修改 ?"，_ 
vbQuestion + vbYesNo + vbDefaultButton2, "修改 记录 ") = vbNo Then Exit Sub 
"修改 更 新 记录 
SQL = "update 销售 信息 set"_ 
& "商品 编码 =" & 商品 编码 .Value& "”_ 
& "商品 名 称 =”& 商品 名 称 .Value& ",”_ 
& "商品 规格 =" & 商品 规格 .Value& ",”_ 
& "计量 单位 =" & 计量 单位 .Value& "”_ 
& "销售 数量 =" & 销售 数量 .Value & ""”_ 
& "销售 单价 =" & 销售 单价 .Value& ","_ 
& "销售 日 期 =" & 销售 日 期 .Value &","”_ 
& "备注 =" & 备注 .Value &""_ 
& "where 销售 编码 =" & 销售 编码 .Value & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
MsgBox "已 经 成 功 将 编码 为 <" & 销售 编码 .Value & "> 的 销售 信息 记录 进行 修改 ! "，_ 
vblnformation, "修改 记录 " 
' 刷 新 查询 和 显示 
查询 销售 信息 
显示 销售 信息 
myListView 
End Sub 
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7.8.8 删除 按钮 单 击 事件 代码 设计 


【删除 】 按 钮 用 于 删除 当前 显示 的 商品 资料 记录 ， 程 序 通 过 一 个 删除 查询 在 数据 库 9 
成 删除 操作 。 删 除 操作 完成 后 ， 程 序 刷 新 了 窗口 显示 的 记录 数据 。 以 下 是 该 过 程 的 详细 代码 
解释 : 

Private Sub 删除 记录 _Click() 

If MsgBox(" 本 操作 将 删除 编码 为 <" & 销售 编码 .Value & "> 的 销售 信息 记录 ! "_ 

& vbCrLf & "是 否 要 删除 ? "，_ 

vbQuestion + vbYesNo + vbDefaultButton2, "删除 记录 ") = vbNo Then Exit Sub 
'---- 删 除 销售 信息 记录 ---- 
SQL = "delete from 销售 信息 where 销售 编码 =" & 销售 编码 .Value & "" 


Set rs = cnn.Execute(SQL) 
MsgBox "已 经 成 功 将 编码 为 <" & 销售 编码 .Value & "> 的 销售 信息 记录 删除 ! "，_ 
vblnformation, "删除 记录 " 
' 刷 新 查询 和 显示 
查询 销售 信息 
显示 销售 信息 
myListView 
End Sub 


7.8.9 查询 按钮 单 击 事件 代码 设计 


元 


个 


在 销售 信息 的 查询 操作 中 只 能 按照 销售 编码 进行 查询 。 单 击 【 查 询 】 按 钮 后 ， 弹 出 
销售 编码 输入 框 ， 在 此 输入 销售 编码 后 ， 程 序 从 数据 库 中 获取 销售 编码 为 用 户 输入 结果 的 所 
有 销售 信息 ， 并 将 查询 到 的 记录 信息 显示 到 窗口 中 。 如 图 7-40 所 示 的 是 该 过 程 的 流程 图 。 


显示 销售 编码 为 myId 的 进货 信息 


图 7-40 【查询 】 按 钮 单 击 事件 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub 查询 记录 _Click() 
Dim myld As String 
Dim SQL As String 
Dim i As Integer 
Dim rsSerch As New ADODB.Recordset 
Call 新 建 记录 _Click 
myld = InputBox(" 请 输入 销售 编码 : " "销售 查询 ") 
If Len(Trim(myld)) = 0 Then 
MsgBox "没有 输入 销售 编码 !", vbCritical, "警告 " 
Exit Sub 
End 上 f 
SQL = "select * from 销售 信息 where 销售 编码 =" & myld & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
Ifrs.BOF And rs.EOF Then 
MsgBox "没有 编码 为 <" & myld & "> 的 销售 信息 必 vbCritical, "查询 结果 " 
Else 
Call 显示 销售 信息 
销售 编码 .Enabled = False 
End If 
End Sub 


7.8.10 ListView 控件 项 目 单 击 事件 代码 设计 


用 户 在 ListView 控件 中 单 击 某 个 项 目 后 ， 程 序 要 将 该 项 目的 所 有 数据 显示 到 窗口 上 部 对 
应 的 文本 框 中 。 程 序 首先 将 各 个 文本 框 的 值 清空 ， 然 后 通过 For 循环 ， 使 用 ListView 控件 的 
ListItems 属性 定位 项 目 里 各 个 子 项 目 ， 并 把 这 些 子 项 目的 数据 显示 到 窗口 上 面 对 应 的 文本 框 
中 。 以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub ListView1_ltemClick(ByVal ltem As MSComctlLib.Listltem) 
On Error Resume Next 
Dim i As Integer 
Call 新 建 记录 _Click 
销售 编码 .Enabled = False 
Me.Controls(myArray(0)).Value = ListView1 .Listltems(ltem.Index) 
Fori= 1 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ListView1.Listltems(ltem.Index).Subltems(i) 
Next 
End Sub 


7.8.11 查询 与 显示 销售 信息 过 程 代码 设计 
查询 与 显示 销售 信息 两 个 过 程 共同 完成 查询 记录 集 并 将 记录 集 数据 显示 到 窗口 的 工作 。 


查询 销售 信息 首先 生成 一 个 查询 销售 信息 字符 串 ， 然 后 按照 该 查询 字符 串 打 开 记 录 集 ， 从 而 
获取 对 应 查询 信息 。 显 示 进 货 信息 过 程 使 用 在 查询 进货 信息 过 程 中 获取 的 供 货 商 信息 记录 集 ， 
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将 该 记录 集 首 条 记录 数据 写 入 到 窗口 的 各 个 对 应 文本 框 中 。 以 下 是 这 两 个 过 程 的 详细 代码 解释 : 
Public Sub 查询 销售 信息 () 
SQL = "select* from 销售 信息 order by 销售 编码 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
End Sub 


Public Sub 显示 销售 信息 () 
On Error Resume Next 
Dim i As Integer 
Call 新 建 记录 _Click 
' 显 示 第 一 个 销售 信息 
rs.MoveFirst 
Fori= 0 To UBound(myArray) 
If IsNull(rs.Fields(i)) Then 
Me.Controls(myArray(i)).Value = ™" 
Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) 
End If 
Nexti 
End Sub 


7.8.12 ”myListView 过 程 代码 设计 


myListView 过 程 完成 ListView 控件 的 显示 设置 以 及 标题 显示 任务 ， 然 后 程序 将 记录 集 rs 
的 所 有 记录 数据 显示 到 控件 上 。 如 图 7-41 所 示 的 是 该 过 程 的 流程 图 。 


设置 ListView 控 件 显示 属性 
设置 ListView 控 件 标题 


获取 记录 集 rs 首 条 记录 


rs 记录 集 末 条 记录 ? 
是 


为 ListView 控 件 添加 项 目 


为 项 目 添加 子 项 目 


图 7-41 myListView 过 程 流程 图 
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以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub myListView() 
On ErrorResume Next 
Dim i As Integer 
"设置 ListView 的 标题 
With ListView1 
.ColumnHeaders.Clear 
.Listltems.Clear 
.View = IlvwReport 
.FullRowSelect = True 
.Gridlines = True 
.Sorted = True 
.ColumnHeaders.Add ,, myArray(0) 
Fori= 1 To UBound(myArray) 
.ColumnHeaders.Add ,, myArray(i) 
Nexti 
' 设 置 ListView 的 各 行 数 据 
i=0 
rs.MoveFirst 
Do While Not rs.EOF 
.Listltems.Add , , rs.Fields(0).Value 
Forj = 1To rs.Fields.Count -1 
.Listltems(i + 1).Subltems(i) = rs.Fields().Value 


Nextj 
rs.MoveNext 
i=i+1 
Loop 
End With 
rs.MoveFirst 
销售 记录 .Caption = "目前 数据 库 中 共有 “" & i & "条 销售 记录 " 
End Sub 
7.9 销售 统计 分 析 窗 体 设 计 
销售 统计 分 析 主 要 对 商品 的 销售 情况 进行 汇总 ， 将 ES 
汇总 数据 输出 到 一 个 新 工作 短 中 ， 并 根据 数据 产生 销售 至 Gan 可 
数据 分 析 图 。 销 售 统计 分 析 窗 体 中 涉及 到 的 项 目 包 括 二 六 外 
统计 起 止 时 间 、 商 品名 称 和 商品 规格 。 该 窗 体 的 界面 如 一 一 FT 一 


图 7-42 所 示 。 


7.9.1 窗口 初始 化 与 关闭 事件 代码 设计 


图 7-42 销售 统计 分 析 界 面 


当 窗 口 首 次 打开 时 ， 窗 口 初始 化 过 程 用 于 对 窗口 中 的 控件 进行 各 项 初始 化 设置 。 在 窗口 
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中 的 各 个 复合 框 都 需要 在 窗口 初始 化 时 为 控件 添加 项 目 。 窗 口中 一 共 包 含 了 4 个 复合 框 ， 其 
中 ， 两 个 日 期 复合 框 被 初始 化 为 系统 的 开启 日 期 。 商 品名 称 和 商品 规格 从 销售 数据 表 中 获取 
非 一 致 的 记录 。 如 果 销 售 表 没有 任何 记录 ， 这 两 个 复合 框 将 不 会 被 初始 化 任何 值 。 该 过 程 的 
流程 图 如 图 7-43 所 示 。 


设置 数据 库 链接 字符 串 


初始 化 起 始 日 志 与 截止 日 基 
| 查询 商品 名 称 记 录 _ 
| 为 商品 名 称 复合 框 设 置 项 目 | 

图 7-43 销售 统计 分 析 窗口 初始 化 流程 图 
以 下 是 该 过 程 以 及 其 调用 的 两 个 过 程 的 详细 代码 解释 : 


Dim cnn As New ADODB.Connection 
Dim rs As ADODB.Recordset 


Private Sub UserForm_lnitialize() 
Dim i As Integer 
Dim SQL As String 
"建立 与 数据 库 的 连接 
With cnn 
.ConnectionString = "Provider=microsoft.jetoledb.4.0;”_ 
& "Data Source=" & ThisWorkbook.Path & "\ 进 销 存 数据 库 .mdb;”_ 
& "Jet Oledb:database password=123456;" "设置 数据 库 链接 字符 串 
.Open "打开 数据 库 
End With 
"设置 时 间 默 认 值 
起 始 日 期 .Value = Date 
截止 日 期 .Value = Date 
' 查 询 销售 信息 数据 表 中 不 重复 的 商品 名 称 
查询 商品 名 称 
为 商品 名 称 复合 框 设置 项 目 
商品 名 称 复合 框 
End Sub 


Private Sub 关闭 退出 _Click() 
rs.Close 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
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Unload 销售 统计 分 析 
End Sub 


7.9.2 ”查询 商品 名 称 过 程 代码 设计 


查询 商品 名 称 过 程 从 数据 库 的 销售 信息 表 中 获取 商品 名 称 记录 集 ， 该 记录 和 集 在 窗口 的 其 
他 一 些 过 程 中 会 被 调用 。 以 下 是 该 过 程 的 详细 代码 解释 : 
Public Sub 查询 商品 名 称 () 
Dim SQL As String 
Set rs = New ADODB.Recordset 
SQL = "select distinct 商品 名 称 fom 销售 信息 ”where 销售 日 期 between"_ 
& 起 始 日 期 .Value & " and " & 截止 日 期 .Value & "" ' 设 置 查询 字符 串 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 获取 记 录 集 
End Sub 


7.9.3 商品 名 称 复合 框 过 程 代 码 设计 


商品 名 称 复 合 框 过 程 用 于 重 置 窗口 的 商品 名 称 复合 框 的 项 目 。 复 合 框 中 所 有 的 项 目 都 源 
于 查询 商品 名 称 过 程 中 获取 的 商品 名 称 字段 记录 。 该 过 程 通过 一 个 Do 循环 将 记录 集中 所 有 商 
品名 称 信息 添加 到 复合 框 的 项 目 中 。 以 下 是 该 过 程 的 详细 代码 解释 : 


Public Sub 商品 名 称 复合 框 () 
On Error Resume Next 
With 商品 名 称 


.Clear ' 清 除 商品 名 称 复合 框 项 目 
Do While Not rs.EOF "循环 记录 集 所 有 记录 
.Addltem rs.Fields(" 商 品名 称 ") 为 商品 名 称 复合 框 添加 项 目 
rs.MoveNext "移动 到 记录 集 下 一 条 记录 
Loop 
End With 
商品 名 称 .ListIndex = 0 "设置 商品 名 称 复合 框 默认 项 目 


End Sub 
7.9.4 ”复合 框 事件 代码 设计 


在 窗口 中 有 3 个 复合 框 都 具有 改变 事件 ， 分 别 是 起 始 日 期 复合 框 、 截 止 日 期 复合 框 和 商 
品名 称 复合 框 。 两 个 日 期 复合 框 内 容 发 生变 化 时 ， 需 要 检查 起 始 日 期 和 截止 日 期 间 的 相互 关 
系 ， 并 且 当 用 户 设置 完 日 期 后 需要 重新 刷新 选 定 日 期 范围 内 的 商品 名 称 项 目 。 商 品名 称 复合 
杠 内 容 发 生变 更 时 ， 需 要 根据 所 选 商品 名 称 更 新 商品 规格 复合 框 的 项 目 。 

两 个 日 期 复合 框 的 改变 事件 相差 不 大 ， 且 这 两 个 事件 过 程 的 流程 十 分 简单 ， 以 下 只 给 出 
商品 名 称 复合 框 改变 事件 过 程 的 流程 图 ， 如 图 7-44 所 示 。 
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为 商品 规格 复合 框 添 加 项 目 
rs 记录 集 下 一 条 记录 


图 7-44 商品 名 称 复合 框 改变 事件 流程 图 
以 下 是 这 几 个 事件 过 程 的 详细 代码 解释 ; 
Private Sub 起 始 日 期 _Change() 
上 起 始 日 期 .Value > 截止 日 期 .Value Then 
MsgBox "起 始 日 期 不 能 大 于 截止 日 期 !", vbCritical, "警告 " 
Exit Sub 
End ff 
' 查 询 销售 信息 数据 表 中 不 重复 的 商品 名 称 
查询 商品 名 称 
为 商品 名 称 复合 框 设置 项 目 
商品 名 称 复合 框 
End Sub 


Private Sub 截止 日 期 _Change() 
lf 截止 日 期 .Value < 起 始 日 期 .Value Then 
MsgBox "截止 日 期 不 能 小 于 起 始 日 期 !", vbCritical, "警告 " 
Exit Sub 
End ff 
' 查 询 销售 信息 数据 表 中 不 重复 的 商品 名 称 
查询 商品 名 称 
为 商品 名 称 复合 框 设置 项 目 
商品 名 称 复合 框 
End Sub 


Private Sub 商品 名 称 _Change() 
On ErrorResume Next 
Dim SQL As String 
"查询 指定 商品 名 称 下 的 不 重复 规格 名 称 
SQL = "select distinct 商品 规格 fom 商品 信息 "_ 
& "where 商品 名 称 =" & 商品 名 称 .Value & "" 
Set rs = New ADODB.Recordset 
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rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 


为 商品 规格 复合 框 设 置 项 目 
With 商品 规格 
.Clear 


Do While Not rs.EOF 
.Addltem rs.Fields(" 商 品 规格 ") 
rs.MoveNext 
Loop 
End With 
商品 规格 .ListiIndex = 0 
End Sub 


7.9.5 ”按钮 单 击 事件 代码 设计 


在 该 窗口 中 一 共 包含 了 两 个 按钮 ， 其 中 统计 分 析 按 钮 的 单 击 事件 代码 比较 复杂 ， 以 下 将 重 
点 介绍 。 重 置 条 件 按钮 用 于 重 置 窗口 中 几 个 


复合 框 的 项 目 。 统 计 分 析 过 程 按照 用 户 设置 
的 查询 条 件 查询 销售 结果 ， 然 后 将 该 结果 做 
统计 分 析 工作 并 将 结果 保存 到 新 工作 矢 中 。 人 


统计 分 析 过 程 首先 创建 新 的 工作 夭 ， 然 
后 在 工作 矢 的 工作 表 中 设置 标题 以 及 统计 表 
图 7-45 “统计 分 析 按钮 单 击 事件 过 程 流程 图 


从 数据 表 


的 表 头 。 随 后 程序 从 数据 库 获取 数据 填充 到 
工作 表 的 对 应 各 列 中 ， 最 后 程序 根据 刚 获取 
的 数据 生成 图 表 。 该 过 程 的 流程 图 如 图 7-45 
所 示 。 
以 下 是 两 个 按钮 单 击 事件 过 程 的 详细 代码 解释 : 
Private Sub 重 置 条 件 _Click() 
On ErrorResume Next 
起 始 日 期 .Value = Date 
截止 日 期 .Value = Date 
商品 名 称 .ListIndex = 0 
商品 规格 .ListiIndex = 0 
End Sub 


Private Sub 统计 分 析 _Click() 
Dim i As Integer 
Dim myDate As Date 
Dim SQL As String 
Dim rsx As ADODB.Recordset 
Dim wb As Workbook 
Dim ws As Worksheet 
"创建 新 工作 簿 
Set wb = Workbooks.Add 
Set ws = wb.ActiveSheet 
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"设置 工作 表 标 题 
ws.Range("A1") = 商品 名 称 .Value & ”的 销售 统计 " 
With ws.Range("A1:E1") 
.Merge 
.Font.Size = 15 
.RowHeight = 20 
.Font.Bold = True 
.HorizontalAlignment = xlCenter 
.Borders(xlEdgeBottom).Weight = xIMedium 
End With 
ws.Range("A2:E2") = Array(" 日 期 ", "商品 名 称 ", "商品 规格 ", "销售 量 ", "销售 额 ") 
' 从 数据 表 中 查询 数据 
i=3 
For myDate = 起 始 日 期 .Value To 截止 日 期 .Value 
ws.Range("A" &i) = Format(myDate, "yyyy-mm-dd") 
ws.Range("B" &i) = 商品 名 称 .Value 
ws.Range("C"& i) = 商品 规格 .Value 
"计算 某 日 指定 规格 之 商品 的 销售 总 数 和 销售 总 额 
lf 商品 规格 .Value = "全 部 规格 " Then 
SQL = "select sum( 销 售 数量 ) as aa,”_ 
& "sum( 销 售 数量 * 销 售 单价 ) as bb from 销售 信息 "_ 
& "where 销售 日 期 =" & myDate &"™_ 
&" and 商品 名 称 =" & 商品 名 称 .Value & "" 
Else 
SQL = "select sum( 销 售 数量 ) as aa,” _ 
& "sum( 销 售 数量 * 销 售 单价 ) as bb from 销售 信息 "”_ 
& "where 销售 日 期 =" & myDate &"™_ 
& "and 商品 名 称 =" & 商品 名 称 .Value &"" _ 
&" and 商品 规格 =" & 商品 规格 .Value & "" 
End If 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenStatic, adLockOptimistic 
IflsNull(rslaa) Then 
ws.Range("D" &i)=0 
Else 
ws.Range("D" & i) = rslaa 
End If 
lf IsNull(rs!bb) Then 
ws.Range("E" &i)=0 
Else 
ws.Range("E" & i) = rslbb 
End If 
i=i+1 
Next 
ws.Columns.AutoFit 
"开始 绘制 统计 分 析 图 表 
Range("A2:E6").Select 
Charts.Add 
ActiveChart.ApplyCustomType ChartType:=xlBuiltin, TypeName:=" 两 轴线 - 柱 图 " 
ActiveChart.SetSourceData Source:= _ 
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Sheets("Sheet1").Range("A2:A" & i -1 & ",D2:E" & i -1), PlotBy:=xlColumns 
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1" 
With ActiveChart 
.HasTitle = True 
.ChartTitle.Characters.Text = 商品 名 称 .Value & "销售 统计 图 表 " 
.Axes(xlCategory, xlPrimary).HasTitle = True 
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "日 期 " 
.Axes(xlValue, xlIPrimary).HasTitle = True 
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "销售 量 " 
.Axes(xlCategory, xlSecondary).HasTitle = False 
.Axes(xlValue, xlSecondary).HasTitle = True 
.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "销售 额 (元 )" 
End With 
Set ws = Nothing 
Set wb = Nothing 
End Sub 


7.10 库存 管理 模块 设计 


库存 管理 模块 通过 库存 管理 窗口 实现 ， 通 过 该 窗口 用 户 可 以 查看 各 个 商品 的 实际 库存 量 。 
该 窗口 只 需要 实现 库存 商品 信息 的 显示 功能 ， 因 此 结构 并 不 复杂 ， 包 含 的 过 程 数 量 并 不 多 。 


7.10.1 库存 资料 管理 窗 体 设计 


库存 资料 管理 窗 体 包含 的 控件 数量 十 分 少 ， 包 含 一 个 框架 控件 、 一 个 ListView 控件 、 

个 标签 控件 和 一 个 按钮 控件 。 框 架 控件 用 于 包含 ListView 控件 ，ListView 控件 用 于 显示 库存 
记录 信息 ， 标 签 用 于 显示 提示 信息 ， 按 钮 用 于 退出 窗口 。 如 图 7-46 所 示 是 该 窗口 的 界面。 

EE 

库存 信息 清单 本 

E 

二 ] | 

- 关 击 明 出 


图 7-46 库存 资料 管理 界面 


< 


第 7 章 进 销 丰 入 束 统 小 


7.10.2 ”窗口 初始 化 过 程 代码 设计 


在 库存 窗口 被 显示 时 ， 为 确保 每 次 显示 的 库存 数据 都 是 更 新 后 的 数据 ， 程 序 需要 重新 获 
取 商 品 的 所 有 销售 数据 和 进货 数据 ， 然 后 根据 这 些 数据 确定 实际 的 商品 库存 量 ， 最 后 将 这 些 
数据 显示 到 窗口 中 并 保存 到 数据 库 库存 信息 表 。 该 过 程 的 流程 如 图 7-47 所 示 。 
建立 与 数据 库 的 连接 


删除 库存 信息 表 所 有 记录 


获取 非 一 致 商品 编码 序列 


图 7-47 库存 窗口 初始 化 过 程 流程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 


Dim myArray As Variant 
Dim cnn As New ADODB.Connection 
Dim rs As ADODB. Recordset 


Private Sub UserForm _lInitialize() 
Dim i As Integer 
Dim n As Long 
myArray = Array(" 商 品 编码 ", "商品 名 称 ", "商品 规格 " "计量 单位 _ 
"库存 数量 ", "库存 单价 ”", "库存 金额 ") 
"建立 与 数据 库 的 连接 
With cnn 
.ConnectionString = "Provider=microsoft.jet.oledb.4.0;" _ 
& "Data Source=" & ThisWorkbook.Path & " 进 销 存 数据 库 .mdb;" _ 
& "Jet Oledb:database password=123456;" 
.Open 
End With 
' 从 进货 信息 数据 表 和 销售 信息 数据 表 中 查询 记录 ， 统 计 商 品 库存 信息 
' 先 删除 库存 信息 数据 表 中 的 所 有 记录 
SQL = "delete from 库存 信息 " 
Set rs = cnn.Execute(SQL) 
"查询 进货 信息 数据 表 中 不 重复 的 商品 编码 
SQL = "select distinct 商品 编码 fom 进货 信息 " 
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Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenStatic, , dCmdText 
n = rs.RecordCount 
lfn <= 0 Then Exit Sub 
ReDim myCode(1 To n) As String 
ReDim myName(1 To n) As String 
ReDim mySpec(1 To n) As String 
ReDim myUnit(1 To n) As String 
ReDim myprice(1 To n) As Single 
ReDim myNum(1 To n, 1 To 2) As Integer 
ReDim myMoney(1 To n, 1 To 2) As Single 
Fori=1Ton 
myCodel(i) = rs.Fields(" 商 品 编码 ") 
rs.MoveNext 
Next 
' 统 计 计算 不 同 商品 编码 对 应 的 商品 进货 数量 、 进 货 单价 和 进货 金额 
Fori=1Ton 
SQL = "select 商品 名 称 ,商品 规格 ,计量 单位 ,进货 单价 fom 进货 信息 "_ 
& "where 商品 编码 =" & myCode(i) & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
myName(i) = rs! 商 品名 称 
mySpec(i) = rs! 商 品 规格 
myUnit(i) = rs! 计 量 单位 
myprice(i) = rs! 进 货 单价 
SQL = "select sum( 进 货 数 量 ) as 数量 ”_ 
&" sum( 进 货 数量 * 进 货 单价 )as 金额 from 进货 信息 "_ 
&" where 商品 编码 =" & myCode(i) & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
myNum(i, 1) = rs! 数 量 
myMoney(i, 1) = rs! 金 额 
Next 
' 统 计 计 算 不 同 商品 编码 对 应 的 商品 销售 信息 
Fori=1Ton 
SQL = "select sum( 销 售 数量 ) as 数量 ”_ 
& " sum( 销 售 数量 * 销 售 单价 ) as 金额 from 销售 信息 " _ 
&" where 商品 编码 =" & myCode(i) & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
lf lsNull(rs! 数 量 ) Then 
myNum(i, 2)= 0 
Else 
myNum(i, 2) = rs! 数 量 
End If 
lf lsNull(rs! 金 额 ) Then 
myMoney(i, 2) = 0 
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Else 
myMoney(i, 2) = rs! 金 额 
End If 
Next 
' 将 汇总 计算 结果 显示 在 ListView 控件 中 
With ListView1 
"设置 ListView 的 标题 
.ColumnHeaders.Clear 
.Listltems.Clear 
.View = lvwwReport 
.FullRowSelect = True 
.Gridlines = True 
.Sorted = True 
.ColumnHeaders.Add ,, myArray(0) 
Fori= 1 To UBound(myArray) 
.ColumnHeaders.Add ,, myArray(i) 
Nexti 
' 设 置 ListView 的 各 行 数 据 
Fori=1Ton 
.Listltems.Add ,, myCode(i) 
.Listltems(i).Subltems(1) = myName(i) 
.Listltems(i).Subltems(2) = mySpec(i) 
.Listltems(i).Subltems(3) = myUnit(i) 
.Listltems(i).Subltems(4) = myNum(i, 1) -myNum(i, 2) 
lf myNum(i, 1) -myNum!(i, 2) = 0 Then 
.Listltems(i).Subltems(5) = 0 
-Listltems(i).Subltems(6) = 0 
Else 
.Listltems(i).Subltems(5) = myprice(i) 
.Listltems(i).Subltems(6) = myMoney!(i, 1) -myMoney!(i, 2) 


End If 
Nexti 
End With 
库存 记录 .Caption = "目前 数据 库 中 共有 "& n & ”条 库存 记录 " 
' 下 面 将 库存 数据 保存 到 库存 信息 数据 表 
' 首 先 删除 库存 信息 数据 表 的 所 有 记录 


SQL = "delete from 库存 信息 " 
Set rs = cnn.Execute(SQL) 
' 将 新 的 库存 信息 保存 到 库存 信息 数据 表 
Set rs = New ADODB.Recordset 
rs.Open "库存 信息 ", cnn, adOpenKeyset adLockOptimistic 
Fori=1Ton 
rs.AddNew 
rs.Fields(" 商 品 编码 ") = myCode(i) 
rs.Fields(" 商 品名 称 " = myName(i) 
rs.Fields(" 商 品 规格 ") = mySpec(i) 
rs.Fields(" 计 量 单位 ") = myUnit(i) 
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rs.Fields(" 库 存 数量 ") = myNum(i, 1) -myNum(i, 2) 

IfmyNum(i, 1) -myNum(i, 2) = 0 Then 
rs.Fields(" 库 存单 价 ) = 0 
rs.Fields(" 库 存 金额 " = 0 

Else 
rs.Fields(" 库 存单 价 ") = myprice(i) 
rs.Fields(" 库 存 金 额 ") = myMoney(i, 1) -myMoney(i, 2) 

End If 

rs.Update 

Nexti 
End Sub 


7.10.3 ”关闭 退出 按钮 代码 设计 


关闭 退出 按钮 用 于 退出 窗口 ， 在 退出 前 该 按钮 单 击 事件 还 需要 清除 一 些 临 时 变量 。 以 下 
是 该 过 程 的 代码 : 
Private Sub 关闭 退出 _Click() 
rs.Close 
cnn.Close 
Set cnn = Nothing 
Set rs = Nothing 
Unload 库存 资料 管理 
End Sub 


7.11 资料 查询 与 导出 


资料 查询 与 导出 窗口 将 系统 中 有 关 数 据 查询 与 导出 的 工作 集中 完成 。 在 前 面 所 介绍 的 进 
销 存 3 个 模块 中 分 别 都 包含 了 部 分 的 查询 与 导出 功能 ， 但 是 这 些 功 能 都 只 涉及 到 对 应 模块 下 
的 查询 与 导出 功能 。 在 本 模块 中 ， 用 户 可 以 完成 所 有 功能 模块 的 查询 与 导出 工作 。 


7.11.1 资料 查询 与 导出 窗 体 设计 


在 本 查询 与 导出 窗口 中 ， 用 户 一 共 可 以 设置 3 个 查询 设置 条 件 。 当 用 户 在 设置 运算 符 选 
择 了 between 时 ， 用 户 还 可 以 设置 两 个 条 件 值 。 而 选择 其 他 的 运算 符 时 ， 只 需要 设置 一 个 查询 
值 就 可 以 了 。 在 窗口 的 右 侧 包含 了 4 个 功能 按钮 ， 分 别 是 重 设 条 件 、 开 始 查询 、 数 据 导 出 和 
关闭 窗口 。 

重 设 条 件 按钮 用 于 重 置 窗口 中 所 有 复合 框 数 据 ， 以 便于 用 户 重 新 输入 查询 数据 。 开 始 查 
询 按钮 将 使 用 用 户 当 前 设置 的 查询 条 件 获取 查询 结果 ， 并 将 查询 结果 显示 在 窗口 底部 的 
ListView 控件 中 。 数据 导出 按钮 用 于 将 查询 所 得 数据 导出 到 一 个 新 的 工作 表 中 。 该 窗口 的 界面 
如 图 7-48 所 示 。 


Ed] 
王 违 择 要 查询 的 资料 称 基 和 设置 查询 条 
区 重 设 条 件 


选择 要 查 光 的 信息 种 闪 | 个 贡 商 区 科 了 
设置 喜光 条 件 
查询 项 目 运算 罕 条 件 什 1 | 
[SRS dF 可 lm 可 
天 查 昌 站 果 显 示 


图 7-48 资料 查询 与 导出 界面 
7.11.2 ”窗口 初始 化 与 关闭 过 程 代码 设计 


窗口 初始 化 时 ， 需 要 完成 的 设置 工作 比较 多 ， 程 序 需要 建立 到 数据 库 的 链接 、 为 窗口 中 
各 个 复合 框 设置 项 目 以 及 重 置 查询 结果 显示 。 如 图 7-49 所 示 是 该 过 程 的 流程 图 。 


建立 与 数据 库 的 连接 
为 信息 种 类 复合 框 设置 项 目 
为 运算 符 复合 框 设置 项 目 


[清除 Listview 控 件 显示 项 目 
图 7-49 资料 查询 与 导出 窗口 初始 化 流程 图 


以 下 是 窗口 初始 化 与 关闭 事件 的 详细 代码 解释 : 


Dim myTable As String 
Dim cnn As New ADODB.Connection 
Dim rs As ADODB. Recordset 
Private Sub UserForm_lnitialize() 
"建立 与 数据 库 的 连接 
With cnn 
.ConnectionString = "Provider=microsoft.jet.oledb.4.0;”_ 
& "Data Source=" & ThisWorkbook.Path & " 进 销 存 数据 库 .mdb;"”_ 
& "Jet Oledb:database password=123456;" 
.Open 
End With 
' 为 信息 种 类 复合 框 设置 项 目 
With 信息 种 类 
.Addltem "商品 资料 " 
.Addltem "商品 资料 " 
.Addltem "进货 资料 " 
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.Addltem "销售 资料 " 
.Addltem "库存 资料 " 
End With 
信息 种 类 .ListIndex = 0 
Select Case 信息 种 类 .Value 
Case "商品 资料 " 
myTable = "商品 信息 " 
Case "商品 资料 " 
myTable = "商品 信息 " 
Case "进货 资料 " 
myTable = "进货 信息 " 
Case "销售 资料 " 
myTable = "销售 信息 " 
Case "库存 资料 " 
myTable = "库存 信息 " 
End Select 
"为 运算 符 复合 框 设置 项 目 
With 运算 符 
.Addltem "=" 
.Addltem ">" 
.Addltem "<" 
.Addltem ">=" 
.Addltem "<=" 
.Addltem "<>" 
.Addltem "like”" 
.Addltem "between" 
End With 
运算 符 .Listtndex = 0 
清除 显示 信息 
End Sub 


Private Sub 关闭 窗 体 _Click() 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
Unload 资料 查询 与 导出 
End Sub 


7.11.3 ”查询 项 目 复 合 框 代 码 设计 


用 户 在 查询 项 目 复合 框 中 选择 了 某 项 目 后 ， 对 应 的 条 件 值 会 随 该 值 发 生 改变 。 程 序 在 查 
询 项 目 复合 框 的 改变 事件 中 实现 该 操作 : 首先 从 数据 库 中 获取 非 一 致 查询 项 目 记 录 集 ， 然 后 
通过 两 个 Do 循环 将 这 些 记 录 数 据 添加 到 条 件 值 1 和 条 件 值 2 两 个 复合 框 中 。 如 图 7-50 所 示 
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从 数据 库 指定 表 中 获取 非 重 复查 询 项 目 字 段 记录 集 


清除 条 件 值 1 复合 框 所 有 项 目 | 
| 为 条 件 值 1 复合 框 添加 项 目 | 
清除 条 件 值 2 复合 框 所 有 项 目 | 
| 为 条 件 信 2 复 合 框 添加 项 目 ， 


图 7-50 查询 项 目 复合 框 改变 事件 过 程 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 


Private Sub 查询 项 目 _Change() 
On Error GoTo hhh 
Dim i As Integer 
Set rs = New ADODB.Recordset 
SQL = "select distinct " & 查询 项 目 .Value & "from " & myTable 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
With 条 件 值 1 
.Clear 
i=1 
Do While Not rs.EOF 
.Addltem rs.Fields( 查 询 项 目 .Value) 
rs.MoveNext 
i=i+1 
Loop 
End With 
条 件 值 1.Listtndex = 0 
rs.MoveFirst 
With 条 件 值 2 
.Clear 
i=1 
Do While Not rs.EOF 
.Addltem rs.Fields( 查 询 项 目 .Value) 
rs.MoveNext 
i=i+1 
Loop 
End With 
条 件 值 2.Listindex = 0 
hhh: 
清除 显示 信息 
End Sub 


7.11.4 ”开始 查询 按钮 代码 设计 


【开始 查询 】 按 钮 使 用 用 户 当前 进行 的 设置 查询 数据 库 ， 将 获取 的 记录 集 显示 到 窗口 的 
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Excel VBA 应 用 开发 经 典 案例 


查询 结果 显示 控件 中 。 程序 通过 一 个 Select 查询 语句 获取 查询 记录 , 该 Select 查询 语句 查询 的 


工作 表 myTable 


1 窗口 初始 化 过 程 确定 。 查 询 条 件 设置 过 程 较 为 复杂 。 按 照 运算 方式 的 不 同 ， 


查询 条 件 的 格式 分 为 3 种 : 为 between 时 ， 需 要 设置 两 个 查询 条 件 值 ， 为 Like 时 ， 需 要 设置 
模糊 查询 格式 ;其 他 的 查询 条 件 下 直接 使 用 运算 符 即 可 。 另 外 ， 查 询 项 目 不 一 样 时 ， 需 要 比 


较 的 值 也 会 不 一 样 。 如 图 7-51 所 示 的 是 该 过 程 执行 流程 图 。 


从 记录 集中 获取 数据 作为 ListView 的 项 目 
图 7-51 【开始 查询 】 按 钮 单 击 事件 流程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 开始 查询 _Click() 


Dim SQL As String 
Dim Condition As String, Con0 As String, Con1 As String, Con2 As String 
"设置 查询 条 件 
Con0 = "where " 
lf 查询 项 目 .Value = "进货 日 期 " Or 查询 项 目 .Value = "销售 日 期 " Then 
Con1 ="" & Format( 条 件 值 1.Value, "yyyy-mm-dd") & 
Con2 ="" & Format( 条 件 值 2.Value, "yyyy-mm-dd")&"" 
Elself 查询 项 目 .Value = "最 高 库存 " Or 查询 项 目 .Value = "最 低 库 存 " _ 
Or 查询 项 目 .Value = "进货 数量 " Or 查询 项 目 .Value = "进货 单价 " _ 
Or 查询 项 目 .Value = "销售 数量 " Or 查询 项 目 .Value = "销售 单价 " _ 
Or 查询 项 目 .Value = "库存 数量 " Or 查询 项 目 .Value = "库存 单价 ”_ 
Or 查询 项 目 .Value = "库存 金额 " Then 
Con1 = Val( 条 件 值 1.Value) 
Con2 = Val( 条 件 值 2.Value) 
Else 
Con1="" & 条 件 值 1.Value &"" 
Con2 ="" & 条 件 值 2.Value &"" 
End If 
Condition = "where " & 查询 项 目 .Value 
lf 运算 符 .Value = "between" Then 
Condition = Condition & " between " & Con1& "and"& Con2 
Elself 运算 符 .Value = "like" Then 
Condition = Condition & " like '%" & 条 件 值 1.Value & "%" 
Else 
Condition = Condition & 运算 符 .Value & Con1 
End If 
"设置 SQL 语句 


SQL = "select* from " & myTable & Condition 
"开始 查询 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
lfrs.BOF And rs.EOF Then 
MsgBox "没有 查询 到 结果 ! ", vbCritical, "查询 结果 " 
清除 显示 信息 
Exit Sub 
End 上 
' 将 查询 结果 显示 在 ListView 控件 中 
With ListView1 
"设置 ListView1 的 标题 、 显 示 类 型 、 整 行 选择 和 网 格 线 属性 
.ColumnHeaders.Clear 
.Listltems.Clear 
.View = lvwwReport 
.FullRowSelect = True 
.Gridlines = True 
为 ListView1 设置 标题 
Fori = 0Tors.Fields.Count -1 
.ColumnHeaders.Add , , rs.Fields(i).Name 
Next 
为 ListView1 设置 各 行 数 据 
i=1 
.Listltems.Clear 
Do While Not rs.EOF 
.Listltems.Add , , rs.Fields(0).Value 
Forj = 1 To rs.Fields.Count -1 
.Listltems(i).Subltems(j) = rs.Fields(j).Value 
Nextj 
rs.MoveNext 
i=i+1 
Loop 
rs.MoveFirst 
End With 
End Sub 


创建 新 工作 簿 并 激活 一 工作 表 ws 
从 记录 集 字段 名 获取 工作 表 列 标题 


设置 工作 表 列 标题 行 格式 


7.11.5 ”数据 导出 按钮 代码 设计 


【数据 导出 】 按 钮 将 用 户 查 询 获 取 结 果 导 出 
到 工作 表 中 。 程序 首先 从 数据 表 中 获取 字段 名 称 
作为 工作 表 的 列 标题 ,然后 调整 标题 的 格式 ， 最 
后 从 数据 记录 集中 获取 数据 填充 到 工作 表 中 完 
成 导出 工作 。 该 过 程 流程 图 如 图 7-52 所 示 。 

以 下 是 该 过 程 的 详细 代码 解释 : 


从 记录 和 集 读 取 数据 到 工作 表 并 设 
置 日 期 与 单 精度 数据 的 显示 格式 


[调整 数据 列 自动 对 齐 | 
图 7-52 【数据 导出 】 按 钮 单 击 事件 过 程 流程 图 
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Private Sub 数据 导出 _Click() 
Dim wb As Workbook 
Dim ws As Worksheet 
Dim i As Integer, j As Integer 
Set wb = Workbooks.Add 
Set ws = wb.ActiveSheet 
With ws 
Fori = 0 To rs.Fields.Count -1 
.Cells(1, i+ 1) = rs.Fields(i).Name 
Next 
With .Range(Cells(1, 1), Cells(1, rs.Fields.Count)) 
.Font.Bold = True 
.HorizontalAlignment = xlCenter 
End With 
i=1 
Do While Not rs.EOF 
Forj = 0 To rs.Fields.Count -1 
.Cells(i+ 1,j + 1) = rs.Fields() 
Ifrs.Fields(j).Type = 135 Then 
.Cells(i + 1,j + 1).NumberFormat = "yyyy-mm-dd" 
End If 
Ifrs.Fields(j).Type = 4 Then 
.Cells(i + 1,j + 1).NumberFormat = "0.00" 
End If 
Next 
rs.MoveNext 
i=i+1 
Loop 
.Columns.AutoFit 
End With 
Set ws = Nothing 
Set wb = Nothing 
End Sub 


7.11.6 ”信息 种 类 复合 框 代 码 设计 


信息 种 类 复合 框 中 的 选项 对 查询 的 信息 进行 了 第 一 级 分 类 。 当 用 户 改变 该 项 选择 时 ， 查 
询 项 目 复合 框 以 及 ListView 控件 的 显示 都 需要 随 之 刷新 。 首 先 ， 程 序 通 过 一 个 Select Case 语 
句 确 定 用 户 选 择 的 信息 种 类 ， i nepal bs 该 数据 表 中 的 字 
段 名 称 将 作为 查询 项 目的 新 项 目 。 其 次 ， 程 序 通过 清除 显示 信息 过 程 清除 ListView 控件 中 所 
有 的 项 目 。 如 图 7-53 所 示 是 该 过 程 的 流程 图 。 
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根据 信息 种 类 确定 查询 工作 表 名 称 
清除 查询 项 目 复合 框 所 有 项 目 
设置 查询 字符 串 并 打开 查询 记录 集 


不 于 记录 集 字段 要 
是 
将 第 i 个 字段 的 字段 名 添加 到 复合 框 


i=itl1 


图 7-53 ”信息 种 类 复合 框 改 变 事件 过 程 流 程 图 
以 下 是 该 过 程 的 详细 代码 解释 : 
Private Sub 信息 种 类 _Change() 
On Error Resume Next 
Select Case 信息 种 类 .Value 
Case "商品 资料 " 
myTable = "商品 信息 " 
Case "商品 资料 " 
myTable = "商品 信息 " 
Case "进货 资料 " 
myTable = "进货 信息 " 
Case "销售 资料 " 
myTable = "销售 信息 " 
Case "库存 资料 " 
myTable = "库存 信息 " 
End Select 
With 查询 项 目 
.Clear 
Set rs = New ADODB.Recordset 
SQL = "select* ffom "& myTable 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 
Fori= 0 To rs.Fields.Count -1 
.Addltem rs.Fields(i).Name 
Next 
End With 
查询 项 目 .ListIndex = 0 
清除 显示 信息 
End Sub 
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7.11.7 ”运算 符 复合 框 事件 代码 设计 


用 户 在 运算 符 复合 框 中 选择 了 between 时 ,条件 值 2 复合 框 会 被 设置 为 可 见 。 此 时 还 要 调 
整 条 件 值 1 和 条 件 值 2 两 个 复合 框 的 宽度 ， 以 使 这 两 个 复合 框 都 能 正确 显示 。 当 再 选中 其 他 
的 运算 符 时 ， 程 序 又 需要 重新 设置 两 个 复合 框 的 状态 。 以 下 是 该 功能 实现 的 过 程 详细 代码 解 
释 ; 


Private Sub 运算 符 _Change() 
上 f 运算 符 .Value <> "between" Then 
Label_and.Visible = False 
Label Value2.Visible = False 
条 件 值 2.Visible = False 
条 件 值 1.Width = 179 
Else 
Label_and.Visible = True 
Label_Value2.Visible = True 
条 件 值 2.Visible = True 
条 件 值 1.Width = 79 
End 上 f 
清除 显示 信息 
End Sub 


7.11.8 重 设 条 件 与 清除 显示 信息 代码 设计 


重 设 条 件 按钮 被 单 击 时 ， 将 重 置 窗口 中 所 有 输入 控件 以 及 刷新 查询 结果 显示 的 数据 ， 其 
中 一 共 涉 及 到 了 窗口 中 的 5 个 复合 框 控件 和 1 个 ListView 控件 。 刷 新 ListView 控件 的 显示 通 
过 调用 清除 显示 信息 过 程 实现 。 以 下 是 这 两 个 过 程 的 详细 代码 解释 : 
Private Sub 重 设 条 件 _Click() 
信息 种 类 .ListIndex = 0 
查询 项 目 .ListlIndex = 0 
运算 符 .ListIndex = 0 
条 件 值 1.Listindex = 0 
条 件 值 2.Listindex = 0 
清除 显示 信息 
End Sub 


Public Sub 清除 显示 信息 () 
With ListView1 
.ColumnHeaders.Clear 
.Listltems.Clear 
.View = IlvwReport 
.FullIRowSelect = True 
.Gridlines = True 
End With 
End Sub 
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7.12 系统 测试 


本 系统 包含 3 个 关键 部 分 ， 分 别 是 商品 的 进 销 存 操作 。 在 本 节 系 统 测试 部 分 不 仅 包含 了 
这 3 个 部 分 的 测试 ， 另 外 还 包含 了 系统 中 各 项 数据 的 查询 测试 ， 以 下 通过 3 个 小 节 分 别 展开 
这 些 内 容 。 由 于 库存 操作 十 分 简单 ， 而 且 属 于 查询 功能 部 分 ， 下 面 将 把 这 部 分 内 容 列 入 到 查 
询 小 节 中 介绍 。 


7.12.1 进货 测试 


(1) 在 加 载 项 菜单 中 依次 选择 【系统 设置 】| 【用户 登录 】 命令， 
在 随后 弹出 的 登录 窗口 中 设置 【用 户 名 】 为 【管理 员 】、【 密 码 】 为 
1111， 如 图 7-54 所 示 ， 单 击 【 确 定 】 按 钮 即 可 。 由 于 系统 中 的 各 项 功 
能 都 有 使 用 权限 ， 为 了 测试 方便 ， 这 里 使 用 了 管理 员 来 登录 ， 以 便 直 ， 
接 使 用 各 项 功能 。 四 和 

(2) 在 加 载 项 菜单 中 依次 选择 【进货 管理 】| 人 【进货 日 常 管理 】 命 令 ， 在 随后 弹出 的 进货 
资料 管理 窗口 中 单 击 【新 建 】 按 钮 ， 然 后 设置 【进货 编码 】 为 IHBM00002，【 供 货 商 编码 】 
设 为 CHDQ, 【商品 编码 】 设 为 SPXX00005， 设 置 【 进 货 数 量 】 为 13、【 进 货 单价 】 为 2000。 
单 击 【保存 】 按 钮 即 可 ， 如 图 7-55 所 示 。 

(3) 用 户 成 功 保存 进货 资料 后 ， 在 进货 信息 
在 该 列表 中 单 击 该 项 销售 数据 查看 或 编辑 该 记录 ， 


清单 的 列表 中 随即 会 刷新 该 项 进货 信息 。 可 
效果 如 图 7-56 所 示 。 


EE 
靳 时 | BF | fx | Mr | 查询 | 关闭 
ES 
LE EE 
这 区 护 码 [nn 供 从 责编 码 |- 习 
商品 编码 :pxxo0005 。。 “] 。 商品 规格 Ee 
计量 位 下 ”当量 5 
i | 


图 7-55 ”进货 资料 管理 窗口 设置 图 7-56 ”进货 资料 管理 
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7.12.2 ”销售 测试 


(1) 在 加 载 项 菜单 中 依次 选择 【销售 管理 】| 【销售 日 常 管理 】 命 令 ， 在 随后 打开 的 销售 
资料 管理 窗口 中 设置 【销售 编码 】 为 XSBM00001、【 商 品 编码 】 为 SPXX00005， 设 置 【 销 售 
数量 】 为 1、【 销 售 单价 】 为 3000。 单 击 【保存 】 按 钮 即 可 。 设 置 资料 管理 界面 如 图 7-57 所 示 。 

(2) 保存 完成 后 ， 该 条 销售 记录 会 立即 显示 在 窗口 的 销售 信息 清单 中 。 单 击 该 条 项 目 ， 
窗口 中 的 数据 会 随 之 刷新 显示 用 户 选择 销售 项 目的 信息 。 新 建 的 销售 清单 信息 如 图 7-58 所 示 。 


加 到 
新 津 保存 修改 出 除 查询 关闭 
销售 基本 信息 


图 7-57 销售 资料 管理 设置 图 7-58 新 建 的 销售 清单 信息 
7.12.3 查询 与 导出 测试 


该 部 分 查询 以 查询 库存 情况 为 例 。 具 体操 作 步 又 如 下 : 

(1) 在 加 载 项 菜单 中 依次 选择 【资料 查询 与 导出 】|【 库 存 资料 查询 与 导出 】 命 令 ， 在 随 
后 打开 的 查询 窗口 中 设置 【查询 项 目 】 为 “商品 编码 ”、【 运 算 符 】 为 =、【 条 件 值 1】 为 
SPXX00001， 如 图 7-59 所 示 。 


区 | 
选择 要 查询 的 资料 和 类 和 讼 置 专 词 条 件 重 设 和 件 
| 库 存 实 料 | 
选择 要 查询 的 信息 种 关 
该 秆 查询 条 件 
查询 顶 目 运算 蔡 条 件 前 1 | 数据 导出 

| 商品 编 吧 sll =| -| 

| Em | | 
一 查询 结果 显示 


7-59 ”资料 查询 与 导出 设置 


_ 
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(2) 在 窗口 中 单 击 【 开 始 查 询 】 按 钮 ， 此 时 窗口 的 查询 结果 显示 列表 中 将 会 显示 该 查询 
结果 ， 如 图 7-60 所 示 。 单 击 【数据 导出 】 按 钮 ， 查 询 活动 的 数据 将 会 被 保存 到 一 个 新 工作 表 
中 ， 如 图 7-61 所 示 。 

习 


图 7-60 查询 结果 显示 
国 aoog -ox 


丙 最 和 各 击 品 揣 生 aa 庆生 大 并 从 大 并 人 而 
骂 SFXX00001 长 虹 彩 电 。 29 二 10.00 1800.00 18000.00 
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图 7-61 导出 查询 数据 


第 8 章 员工 管理 系统 


员工 管理 是 企业 管理 的 重要 内 容 之 一 。 合 理 的 人 事 管 理 可 以 帮助 公司 培养 一 支 有 纪律 、 
高 素质 团结 合作 的 队伍 ， 同 时 也 会 为 公司 树立 良好 形象 英 定 基础 ， 促 进 企业 发 展 ， 而 员工 管 
理 系 统 就 实现 了 对 员工 信息 的 集中 而 系统 的 管理 ， 使 得 管理 者 可 以 更 加 轻松 地 完成 员工 信息 
的 存储 与 查询 操作 。 


8.1 系统 概论 


员工 管理 系统 包含 员工 档案 管理 与 员工 考勤 管理 。 员 工 档案 管理 主要 完成 员工 资料 的 建 
立 、 编 辑 和 查询 操作 。 员 工 的 考勤 管理 主要 完成 签到 、 请 假 登记 操作 ， 是 计算 员工 工资 报酬 
的 重要 依据 。 


8.1.1 设计 思路 


员工 管理 系统 一 共 包 含 了 3 个 主要 功能 ， 分 别 对 应 首页 的 3 
个 按钮 ， 即 员工 信息 资料 管理 、 员 工 考勤 签到 和 员工 请 假 登记 。 
该 系统 的 架构 如 图 8-1 所 示 。 

员工 管理 系统 包含 了 主页 表 、 员 工 档案 卡 表 、 请 假 登记 表 、 
考勤 表 、 库 表 和 参数 表 6 个 表 。 系 统 将 所 有 员工 的 信息 存储 在 一 
个 员工 库 表 中 ， 在 其 中 可 以 完成 员工 档案 的 建立 、 编 辑 和 查询 操 
作 。 以 下 是 各 个 表 的 详细 功能 介绍 。 

口 、 主 页 表 : 该 表 是 系统 的 首页 ， 完 成 功能 跳 转 工作 。 

口 、 员 工 档案 卡 表 : 用 于 显示 员工 档案 卡 。 在 该 表 中 可 以 完 
成 所 有 与 员工 档案 相关 的 操作 ， 包 括 增加 、 删 除 、 修 改 、 
查询 、 浏 览 记 录 等 。 

口 “请假 登 记 表 :该 表 存 储 员工 请 假 信息 ， 包 括 姓名 、 事 由 、 起 止 日 期 。 

考勤 表 ， 该 表 保 存 各 个 员工 的 出 勤 情况 ， 是 工资 结算 的 重要 依据 。 
口 “ 库 表 ， 该 表 用 于 存储 所 有 已 建立 档案 的 员工 资料 信息 。 主 页 表 操 作 的 数据 都 来 源 于 

该 表 。 

口 “参数 表 ， 该 表 保 存 系统 用 到 的 一 些 设置 信息 。 
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图 8-1 员工 管理 系统 结构 图 
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8.1.2 ”知识 点 一 : 名 称 


在 Excel 中 应 用 单元 格 时 ， 可 以 使 用 行列 号 ， 也 可 以 首先 
对 单元 格 进行 命名 ， 然 后 使 用 该 名 称 调用 该 单元 格 。 命 名 时 ， 。 强攻 - 
首先 选中 需要 命名 的 单元 格 ,然后 依次 选择 【公式 】|【 定 义 名 


称 】 命 令 ， 弹 出 【新 建 名 称 】 对 话 框 ， 在 【名 称 】 文 本 框 中 输 目 

入 新 名 称 即 可 ， 如 图 8-2 所 示 。 | 

Cw |] we | 

通过 VBA 也 可 以 建立 名 称 ，Names 对 象 代表 了 在 单元 区 
域 上 的 定义 名 。Names 集合 是 应 用 程序 或 工作 竹中 所 有 Name 图 8-2 定义 名 称 


(名 称 ) 的 集合 。 通 过 VBA 添加 名 称 时 ， 可 用 Add 方法 创建 名 称 并 将 其 添加 到 集合 中 。 下 面 
是 Add 方法 的 一 个 实例 : 
Names.Add Name=" 新 名 称 ",RefersTo="=sheet1!$A$1:$G$10" 
其 中 ，Name 参数 是 该 新 名 称 的 自 定 义 名 。RefersTo 参数 必须 以 Al 单元 格 样式 表示 法 指 
定 。 上 面 的 实例 指定 sheetl 的 Al:G10 单元 格 区 域 的 名 称 为 “新 名 称 ”。 


8.1.3 ”知识 点 二 : 使 用 OnTime 方法 


Application 对 象 的 OnTime 方法 可 以 定时 触发 过 程 。 定 时 可 以 是 一 个 具体 时 间 ， 也 可 以 
指定 在 某 段 时 间 之 后 。 当 在 程序 中 需要 运用 到 定时 运行 过 程 时 ， 该 方法 十 分 方便 。 它 的 语法 
参照 以 下 格式 : 

Application.OnTime(EarliestTime, Procedure, [LatestTime, Schedule]) 

其 中 用 中 括号 括 起 来 的 是 可 选 参数 。 EarliestTime 是 过 程 运行 的 时 间 , Procedure 为 过 程 名 ， 
LatestTime 是 过 程 运行 最 迟 时 间 。Schedule 参数 是 一 个 布尔 值 ， 当 其 为 False 时 ， 清 除 前 面 定 
义 的 过 程 ， 为 True 时 ， 将 预定 一 个 新 过 程 ， 默 认 值 为 True。 下 面 是 该 方法 使 用 的 一 个 实例 : 

Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure" 

该 语句 的 意义 为 从 执行 该 语句 开始 后 的 15 秒 将 自动 运行 my_Procedure 过 程 。 


8.1.4 知识 点 三 : Range 对 象 的 Sort 方法 


排序 是 在 编程 过 程 中 经 常 碰 到 的 事情 ， 通 过 编程 完成 排序 的 工作 也 不 算是 件 简单 的 事情 ， 
但 是 在 Excel 的 编程 中 ， 要 完成 排序 不 一 定 需要 自己 编程 完成 该 工作 。Range 对 象 的 Sort 方法 
可 以 指定 单元 格 区 域 进行 排序 工作 ， 而 且 速 度 十 分 快捷 。 以 下 是 该 方法 的 格式 : 

Range. Sort([Key1, Order1,Key2,Type,Order2,Key3,Order3,Header,OrderCustom,MatchCase, Orientation , 

SortMethod, DataOption1, DataOption2, DataOption3]) 


该 方法 的 参数 众多 , 但 这 些 参 数 都 是 可 选 的 。 Keyl、 Orderl、 Key2、Type、 Order2、Key3、 
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Order3 这 些 参数 可 以 连续 指定 3 个 排序 字段 。Order 参数 则 指定 对 应 字段 的 排序 顺序 。Header 
参数 确定 第 一 行 是 否 包含 标题 。OrderCustom 指定 在 自 定义 排序 次 序列 表 中 的 基于 一 的 整数 偏 
移 。 MatchCase 确定 排序 时 是 否 区 分 大 小 写 。Orientation 指定 以 升序 还 是 降序 排序 。SortMethod 
指定 排序 方法 。DataOption 参数 指定 对 应 的 字段 区 域 中 文本 的 排序 方式 。 以 下 是 该 方法 的 一 个 
应 用 实例 : 

Sheet1.Range("A1:F50").Sort Key1:=Range("C1"), _ 


Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _ 
Orientation:=xITopToBottom, SortMethod:=xlPinYin, DataOption1:=xlSortNormal 


以 上 代码 将 在 sheetl 表 的 Al 到 F50 单元 格 区 域内 按照 C 列 进行 排序 ， 排 序 方式 为 升序 。 


8.1.5 知识 点 四 : Countlf 函数 


CountIf 函数 可 以 很 容易 地 计算 区 域 中 满足 条 件 的 单元 格 个 数 ,该 函数 是 内 置 工作 表 函 数 ， 
在 工作 表 的 单元 格 中 输入 该 函数 即 可 直接 使 用 。 当 在 VBA 代码 中 使 用 时 ， 必 须 在 该 函数 之 前 
采用 WorksheetFunction.CountIf 的 方式 调用 。 该 函数 的 格式 如 下 : 

Countlf(Arg1, Arg2) 


其 中 Argl 参数 指定 需要 计算 单元 格 个 数 的 区 域 , Arg2 指定 哪些 单元 格 将 被 计算 在 内 的 条 
件 , 其 形式 可 以 为 数字 、 表 达 式 、 单元 格 引 用 或 文本 。 例 如, 条 件 可 以 表示 为 32、"32"、">32"、 
"apples" 或 B4。 可 以 在 条 件 中 使 用 通配符 ， 包 括 问 号 (?) 和 星 号 (*)。 问 号 可 匹配 任意 的 单 
个 字符 ， 星 号 可 匹配 任意 一 串 字 符 。 如 果 要 查找 实际 的 问号 或 星 号 ， 则 应 在 该 字符 前 输入 一 
个 波形 符 (~)。 

在 本 章 的 实例 的 考勤 表 中 使 用 到 了 该 函数 。 例 如 ，AH5 单元 格 的 公式 为 CountIf 
($C5:$SAG5," V")。 它 统计 的 是 C5 到 AG5 单元 格 区 域 中 包含 “v ”的 单元 格 个 数 ， 即 该 员工 
正常 出 勤 的 天 数 。 


8.1.6 知识 点 五 : DateDiff 函数 


DateDiff 函数 可 以 计算 两 个 日 期 间 的 时 间 间 隔 , 最 终 返 回 的 结果 将 根据 参数 指定 的 不 同 而 
不 同 。 该 函数 的 语法 如 下 : 

DateDiff(interval, date1, date2[, firstdayofweek[, firstweekofyean]) 

interval 用 来 计算 datel 和 date2 的 时 间 差 的 时 间 间 隔 ， 当 指定 为 不 同 值 时 ， 返 回 的 结果 会 
不 一 样 。date1、date2 分 别 指定 两 个 日 期 ，firstdayofweek 指定 一 个 星期 的 第 一 天 的 常数 。 如 果 
未 予 指 定 ， 则 以 星期 日 为 第 一 天 。firstweekofyear 指定 一 年 的 第 一 周 的 常数 。 如 果 未 予 指定 ， 
则 以 包含 1 月 1 日 的 星期 为 第 一 周 。 下 面 是 该 函数 使 用 的 一 个 实例 : 

Msgbox DateDiff("d", "2007-11-5", "2007-12-5") 

以 上 代码 将 显示 一 个 消息 框 ,消息 框 中 显示 的 数据 为 30, 即 2007 年 11 月 5 号 与 2007 年 
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12 月 5 号 的 日 期 间隔 为 30 天 。 如 果 将 其 中 的 “d” 换 成 “m”， 返 回 的 结果 为 1， 因 为 两 个 日 
期 的 月 份 间隔 为 1。 


8.2 ”工作 簿 对 象 与 表 设计 
员工 档案 管理 系统 包括 6 个 表 ， 分 别 是 主页 表 、 员 工 档案 卡 表 、 请 假 登记 表 、 考 勤 表 、 
库 表 和 参数 表 。 本 小 节 将 讲述 这 6 个 表 的 具体 设计 与 工作 敌对 象 过 程 。 
8.2.1 主页 表 
下 面 详细 讲述 该 主页 表 的 设计 方法 与 步骤 。 
(1) 新 建 “ 主 页 ”工作 表 。 在 Excel 2007 中 依次 选择 【开始 】| 【单元 格 】|【 插 入】|【 插 


入 工作 表 】 命令, 如 图 8-3 所 示 。 随后 右 击 新 插入 工作 表 的 标签 , 在 弹出 的 快捷 菜单 中 选择 【 重 
命名 】 命 令 ， 然 后 将 其 文字 内 容 修改 为 “主页 ”。 


= T 人 -x 
国生 PT 大 ”他 三 雪 并 


着 实生 -2 .于 二 避 <e A 
J ed Ee 
MESEs ET A 
Ea | me 7 | 


4 B 了 nD E E 


ml 主页 员工 入 乏 卡 。 测 相交 记 直 ， 考 上 未 并 ， 考 台 基 。 府 ， 多 入 
CI] 


图 8-3 ”插入 工作 表 操作 示意 图 
(2) 工作 禾 设 置 。 选 择 Excel 2007 左上 角 的 Office 菜单 并 单 击 【Excel 选项 】 按 钮 。 在 


随后 显示 的 【Excel 选项 】 对 话 框 左 侧 选择 【 高级】 选项， 在 其 右 侧 找到 工作 短 与 工作 表 显 示 
选项 设置 ， 修 改 设置 如 图 8-4 所 示 。 


图 8-4 【Excel 选项 】 设 置 
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(3) 添加 外 层 矩 形 。 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】|【 和 矩形 】 命 令 。 在 工作 
表 空 白 区 域 单 击 鼠 标 左 键 并 拖 动 以 产生 一 个 适当 大 小 的 矩形 形状 ， 随 后 右 击 矩 形 形 状 ， 在 弹 
出 的 快捷 菜单 中 选择 【设置 形状 格式 】 命 令 ， 打开 【 设 置 形状 格式 】 对 话 框 。 

(4) 设置 外 层 矩 形 格 式 。 在 【设置 形状 格式 】 对 话 框 中 选择 【阴影 】 选 项 。 随 后 在 其 右 
侧 的 【 预 设 】 下 拉 列 表 框 中 选择 【外 部 】 分 类 中 的 【 右 下 斜 偏 移 】 选 项 。 然 后 再 次 右 击 该 矩 
形 ， 在 弹出 的 快捷 菜单 中 依次 选择 【 置 于 底层 】|【 团 于 底层 】 命 令 。 最 后 再 右 击 该 矩形 ， 在 
弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 并 输入 文字 内 容 为 “员工 管理 系统 ”。 

(5) 添加 按钮 。 在 Excel 2007 中 依次 选择 【插入 】| 【形状 】|【 圆 角 算 形 】 命 令 。 在 工作 
表 空 白 区 域 单 击 鼠 标 左 键 并 拖 动 以 产生 一 个 适当 大 小 的 圆 角 和 矩形 ， 右 击 该 形状 ， 在 弹出 的 快 
捷 菜 单 中 选择 【设置 形状 格式 】 命 令 ， 打开 【 设 置 形状 格式 】 对 话 框 。 在 【设置 形状 格式 】 
对 话 框 中 选择 【填充 】 选 项 并 在 其 右 侧 选 中 【渐变 填充 】 单 选 按钮 ， 随 后 在 【颜色 】 下 拉 列 
表 框 的 【标准 色 】 分 类 中 选择 【橙色 】 选 项 。 然 后 再 设置 该 形状 的 阴影 效果 ， 其 设置 方法 与 
步骤 (4) 相同 ， 这 里 不 再 多 做 说 明 。 最 后 右 击 该 矩形 ,在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 
命令 后 输入 文字 内 容 为 “员工 资料 管理 ”。 

(6) 右 击 刚 创建 圆 角 矩形 并 选择 【复制 】 命 令 ， 将 其 粘贴 两 次 。 将 两 圆 角 和 下 形 拷贝 的 文 
字 内 容 分 别 修改 为 “考勤 签到 ”和 “请 假 登 记 ”。 其 修改 的 方法 在 步骤 (4) 和 步骤 (5) 中 
都 有 说 明 ， 这 里 不 再 歼 述 。 

(7) 为 形状 按钮 指定 宏 。 右 击 各 个 形状 按钮 ， 在 弹出 的 快捷 菜单 中 选择 【指定 宏 】 命 令 ， 
打开 【指定 宏 】 对 话 框 。 在 【指定 宏 】 对 话 框 中 分 别 指定 各 个 按钮 的 宏 过 程 。 其 相应 的 宏 过 
程 名 称 与 其 文字 内 容 相同 。 

设计 好 的 主页 表 界面 如 图 8-5 所 示 。 


员 荆 管理 素 统 


图 8-5 员工 管理 系统 主页 
8.2.2 ”员工 档案 卡 表 界面 设计 


员工 档案 卡 表 界 面 设计 步骤 如 下 : 

(1) 修改 工作 表 标签 名 。 右 击 工作 表 标 签 ， 在 弹出 的 快捷 菜单 中 选择 【 重 命名 】 命 令 ， 
随后 输入 文字 内 容 为 “员工 档案 卡 ”。 

(2) 合并 单元 格 。 工 作 表 中 很 多 地 方 需要 合并 单元 格 ， 以 便于 对 齐 文字 及 输入 。 例 如 
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D5:F5 单元 格 区 域 对 应 “所 学 专业 ”的 内 容 。 合 并 时 首先 选中 该 区 域 并 右 击 鼠 标 ， 在 弹出 的 快 
捷 菜 单 中 选择 【设置 单元 格格 式 】 命 令 ， 打 开 【 设 置 单元 格格 式 】 对 话 框 ， 选 择 【对 齐 】 选 
项 卡 。 随 后 在 【文本 控制 】 分 类 中 选中 【合并 单元 格 】 复 选 框 。 

(3) 设置 边框 格式 。 选 中 A2:G19 单元 格 区 域 并 右 击 鼠 标 ， 在 随后 弹出 的 快捷 菜单 中 选 
择 【 设 置 单 元 格格 式 】 命 令 ， 打 开 【 设 置 单 元 格格 式 】 对 话 框 ， 选 择 【边框 】 选 项 卡 ， 在 【和 预 
置 】 分 类 中 选择 【外 边框 】 和 【内 部 】 复 选 框 即 可 。 

(4) 设计 标题 。 在 合并 后 的 单元 格 区 域 A1:G1 中 双击 并 输入 文字 内 容 为 “职工 档案 卡 ”。 

(5) 文字 部 分 。 需 要 预先 设计 的 文字 部 分 是 对 应 项 目的 提示 文字 ， 即 在 库 表 中 的 列 标题 。 
主页 表 的 文字 部 分 是 通过 链接 库 表 对 应 的 列 标题 实现 的 。 例 如 “职工 编号 ”提示 文字 ， 其 链 
接 的 是 库 表 中 的 Al 单元 格 ， 这 里 使 用 公式 “= 库 !A1” 即 可 。 其 他 文字 部 分 与 此 类 似 。 关 于 为 
何 要 使 用 链接 ， 将 在 查询 功能 模块 详细 讲述 。 

(6) 插入 图 像 控 件 。 通 过 图 像 控 件 ， 可 以 在 档案 卡 中 显示 员工 照片 。 在 Excel 2007 中 依 
次 选择 【开发 工具 】| 【控件 】|【 插 入 】 命 令 。 然 后 在 ActiveX 控件 分 类 中 选择 图 像 控件 。 随 
后 在 员工 档案 卡 表 中 插入 一 图 像 控 件 并 将 其 位 置 与 大 小 对 齐 到 G2:G6 单元 格 区 域 。 

(7) 设置 图 像 控件 显示 效果 。 图 像 控件 默认 的 图 像 显示 时 会 将 超出 部 分 自动 剪裁 。 为 了 
防止 部 分 员工 图 片 过 大 而 造成 只 能 显示 一 部 分 的 情况 出 现 ， 应 该 设置 图 像 控件 的 显示 模式 。 
在 图 像 控 件 上 右 击 ， 在 弹出 的 快捷 菜单 中 选择 【属性 】 命 令 ， 打 开 【 属 性 】 对 话 框 ， 将 
PictureSizeMode 属性 修改 为 “3-fmPictureSizeModeZoom” 即 可 。 该 表 的 界面 如 图 8-6 所 示 。 


RE 


图 8-6 员工 档案 卡 表 
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8.2.3 ”员工 档案 卡 表 代码 设计 


员工 档案 卡 表 中 包括 5 个 事件 过 程 ， 分 别 是 图 像 控 件 上 鼠标 滑动 事件 过 程 、 图 像 控 件 
单 击 事件 过 程 、 工 作 表 改 变 事件 过 程 、 工 作 表 激 活 事件 过 程 以 及 工作 表 失 去 激活 事件 过 程 。 
下 面 分 别 讲述 5 个 事件 过 程 的 作用 与 代码 。 
1. 图 像 控 件 上 鼠标 滑动 事件 过 程 
当 鼠 标 在 图 像 控件 上 滑动 时 ， 需 要 将 已 经 在 G2 单元 格 中 设置 好 的 批注 显示 出 来 ， 当 该 批 
注 显示 了 1 秒 后 应 该 被 自动 隐藏 起 来 。 该 事件 过 程 的 代码 如 下 : 
Private Sub Image1 MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, 
ByVal Y As Single) 
' 显 示 G2 批注 提示 
Range("g2").Comment.Visible = True 
' 将 批注 提示 显示 1 秒 后 隐藏 


Application.OnTime Now + TimeValue("00:00:1"), "Hidden_ Comment" 
End Sub 
2. 图 像 控件 单 击 事件 过 程 
当 单 击 图 像 控件 时 ， 弹 出 【文件 获取 】 对 话 框 ， 以 获取 员工 照片 的 存储 位 置 。 该 图 像 的 
位 置 将 会 被 保存 在 G2 单元 格 中 。 
Private Sub Image1_Click() " 单 击 图 像 控件 添加 相片 地 址 
If Range("B2").HasFormula = True Then End 
Dim Fd As FileDialog 
Set Fd = Application.FileDialog(msoFileDialogFilePicker) 
With Fd 
.Title = "选取 个 人 相片 " 
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1 ' 图 像 类 型 
.AllowMultiSelect = False ' 不 能 多 选 
lf .Show = -1 Then 
ActiveSheet.Unprotect 
Range("g2").Value = Fd.Selectedltems(1) 
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
ActiveSheet.EnableSelection = xlUnlockedCells 
Picture_Load ' 显 示 图 片 
End If 
End With 
Set Fd = Nothing 
Range("c3").Select 
End Sub 


3. 工作 表 改 变 事 件 过 程 
当 工 作 表 内 容 发 生变 化 时 ， 需 要 检测 当前 是 否 处 于 查询 状态 。 当 处 于 查询 状态 时 ， 需 要 
给 查询 过 程 传递 参数 ， 并 执行 该 查询 过 程 。 
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Private Sub Worksheet_Change(ByVal Target As Range) "记录 寻找 
If Find_Status = True Then 
Data_Search Target.Offset(0, -1).Formula, Target.Value 
End If 
End Sub 


4. 工作 表 激 活 事件 过 程 

当 工 作 表 被 激活 时 ， 系 统 将 为 该 人 事 档 案 卡 表 生 成 一 个 菜单 栏 。 该 菜单 栏 包 含 了 所 有 对 
人 事 档案 卡 表 的 操作 ， 该 菜单 栏 的 界面 如 图 8-7 所 示 。 该 工作 表 激 活 事 件 过 程 的 流程 图 如 图 
8-8 所 示 。 


添加 人 事 档 案 菜单 栏 


事 和 档案 菜单 程 中 添加 各 际 
钮 并 设置 各 个 按钮 的 执行 过 程 


将 员工 档案 卡 显示 记录 定位 到 库 表 最 后 一 条 
一 调用 图 片 加 载 过 程 加 载 最 后 一 个 员工 的 图 片 


图 8-7 人 事 档案 卡 表 菜单 图 8-8 工作 表 激活 事件 过 程 流程 图 
生成 该 菜单 栏 的 代码 如 下 : 
Private Sub Worksheet_Activate() 
Application.ScreenUpdating = False 
With Application.CommandBars.Add(" 人 事 档 案 菜单 ") 

.Visible = True 

.Position = msoBarFloating 

Dim myButton As CommandBarButton 

With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "增加 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_add" 
myButton.TooltipText = "增加 记录 " 
myButton.Enabled = True 

End With 

With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "修改 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_modify" 
myButton.TooltipText = "修改 记录 " 
myButton.Enabled = True 

End With 

With .Controls 


增加 修改 保存 删除 复制 补贴 豆 词 站 笔 前 嫌 后 机 未 牧 
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Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "保存 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_save” 
myButton.TooltipText = "保存 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "删除 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_del" 
myButton.TooltipText = "删除 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "复制 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_copy” 
myButton.TooltipText = "复制 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "粘贴 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_paste" 
myButton.TooltipText = "粘贴 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "查询 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "DataFind_Status" 
myButton.TooltipText = "查询 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = " 首 笔 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 


myButton.OnAction = "data_first" 
myButton.TooltipText = " 首 笔 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "前 翻 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_pageup" 
myButton.TooltipText = "前 翻 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "后 翻 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_pagedown" 
myButton.TooltipText = "后 翻 记录 " 
myButton.Enabled = True 
End With 
With .Controls 
Set myButton = Application.CommandBars(" 人 事 档案 菜单 ").Controls.Add 
myButton.Caption = "未 笔 " 
myButton.Style = msoButtonCaption 
myButton.BeginGroup = True 
myButton.OnAction = "data_last" 
myButton.TooltipText = "未 笔记 录 " 
myButton.Enabled = True 
End With 
End With 
Worksheets(" 参 数 ").Range("a2").Value = Worksheets(" 库 ").UsedRange.Rows.Count -1 
"获得 未 笔记 录 
Application.ScreenUpdating = True 
Picture_Load 
End Sub 


S. 工作 表 失 去 激活 事件 过 程 

当 通 过 不 同 的 方式 从 该 员工 档案 卡 表 切换 到 其 他 工作 表 时 ， 将 发 生 工作 表 失 去 激活 习 
此 时 需要 删除 在 工作 表 激 活 事件 中 生成 的 菜单 栏 ， 因 为 该 菜单 栏 只 支持 员工 档案 卡 表 中 
作 。 该 事件 过 程 的 代码 如 下 : 

Private Sub Worksheet_Deactivate() 


Application.CommandBars(" 人 事 档案 菜单 ").Delete 
End Sub 


有 件 。 
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8.2.4 ”请 假 登记 表 设计 二 


请 假 登记 表 主 要 记录 请 假 员工 的 姓名 、 请 假 事由 以 及 请 假 | 


的 期 限 。 该 表 的 结构 十 分 简单 ， 结 构 如 图 8-9 所 示 。 人 


图 8-9 请 假 登记 表 界面 
8.2.5 考勤 表 设 计 


考勤 表 用 于 登记 员工 一 个 月 内 的 考勤 情况 ， 该 表 对 于 财务 进行 工资 报酬 计算 十 分 重要 。 
该 表 的 结构 如 图 8-10 所 示 。 


Pr = 
A Db CDIEFOBITIEL NNO PIQIRS TIDIW WRIY 2 AkADhc ADiaEIAF AG 人 | AL 要 相 坟 人 如 


3 
员工 呈 妈 名 1|2| 3 4 s|el "lel ell sle ls 
器 懂 人 性 必 和 全 


qoa009900090Gnnnn 
f T T 面 四 


图 8-10 考勤 表 界 面 
8.2.6 库 表 设计 


库 表 保存 了 所 有 登记 了 的 员工 的 信息 。 库 表 的 界面 如 图 8-11 所 示 ， 以 表 列 的 形式 存储 了 
所 有 的 数据 。 该 表 的 设计 十 分 简单 ， 此 处 不 再 列 出 设计 步骤 。 


8.2.7 ”参数 表 设计 


参数 表 中 存储 了 在 该 系统 中 需要 使 用 到 的 参数 , 对 应 的 
参数 都 附加 相关 的 说 明 ， 如 图 8-12 所 示 。 


图 8-12 参数 表 设计 


8.2.8 ”工作 簿 对 象 设计 


工作 敌对 象 包含 了 3 个 事件 过 程 ， 分 别 是 工作 敌 开 启事 件 过 程 、 工 作 敌 关 闭 事 件 过 程 和 
工作 矢 保 存 事 件 过 程 。 工 作 簿 的 开启 事件 过 程 用 于 初始 化 工作 簿 的 一 些 状态 。 工 作 短 关闭 事 
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件 过 程 用 于 删除 系统 建立 的 菜单 并 且 保存 工作 筹 。 工 作 短 保 存 事件 过 程 用 于 保存 员工 库 表 记 
录 数 以 及 清空 图 像 控 件 的 显示 。 详 细 代 码 解 释 如 下 : 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
Workbooks(" 人 事 档 案 .xls").Save 
Application.Caption = "Microsoft Excel" 
End Sub 


Private Sub Workbook_BeforeSave(ByVal SaveAsUlI As Boolean, Cancel As Boolean) 
Worksheets(" 参 数 ").Range("a2").Value = Worksheets(" 库 ").UsedRange.Rows.Count ' 获 得 未 笔记 录 
Sheets(" 员 工 档案 卡 ").Image1.Picture = LoadPicture("") 

' 此 命令 行 作用 为 设置 图 像 控件 相片 为 空 ,否则 保存 会 占用 较 多 空间 

End Sub 


Private Sub Workbook_Open() 
Application.Caption = "人 事 档 案 系 统 " 
Application.MoveAfterReturnDirection = xIToRight 
ActiveWindow.Caption = "人 事 档案 系统 " 

End Sub 


8.3 设计 员工 档案 卡 模块 代码 


员工 的 个 人 档案 资料 都 是 在 员工 档案 卡 中 进行 管理 的 。 当 该 表 被 激活 时 ， 会 生成 对 应 的 自 
定义 工具 栏 ， 该 工具 栏 中 包含 了 所 有 在 该 工作 表 中 需要 完成 操作 的 命令 按钮 ， 包 括 记录 增加 、 
修改 、 删 除 、 查 询 、 浏 览 以 及 返回 主页 的 【返回 】 按 钮 。 下 面 介绍 该 员工 档案 模块 的 详细 代码 。 


8.3.1 变量 定义 


在 该 模块 中 有 部 分 自 定义 变量 。 在 介绍 该 部 分 代码 前 ， 首 先 应 弄 清楚 这 些 变 量 的 意义 ， 
理解 相应 代码 的 意图 。 以 下 是 变量 定义 解释 : 

"该 单元 格 对 象 用 在 For.…Each 循环 中 ， 用 于 指 代 单元 格 区 域 中 单个 的 单元 格 

Dim Input_Cell As Range 

以 下 变量 分 别 代 表 当前 行 号 ， 当 前 列 号 ， 库 表 中 末 笔 记录 行 号 

Dim Current_Row, Current_Col, Large_Row As Integer 

' 用 于 界定 当前 是 否 处 于 查询 状态 

Public Find_Status As Boolean 


8.3.2 ”记录 新 增 操作 


重 置 单元 格 
重 置 相片 控件 


当 添 加 员工 档案 时 ， 在 系统 中 需要 完成 部 分 初始 工作 。 
这 些 工 作 包 括 设 置 非 查 询 状态 、 检 查 是 否 已 处 于 新 增 记 录 操 
作 、 解 除 工作 表 保 护 。 其 增加 步骤 如 图 8-13 所 示 。 


图 8-13 ”记录 增加 步骤 
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' 增 加 记录 


Sub Data_ Add() 
"设置 当前 为 非 查 询 状 态 
Find_Status = False 
"检查 职 工 编号 单元 格 是 否 已 经 有 记录 ， 当 该 单元 格 为 空 时 , 说 阴 当 前 正 完成 增加 记录 操作 ， 退 出 该 过 程 
If Range("B2").HasFormula = False Then End 


Application.ScreenUpdating = False "关闭 应 用 程序 刷新 

ActiveSheet.Unprotect "解除 工作 表 锁 定 

Large_Row = Worksheets(" 库 ").UsedRange.Rows.Count 获得 未 笔记 录 行 号 

Worksheets(" 参 数 ").Range("a2").Value = Large_Row ' 保 存 未 笔记 录 行 号 

For Each Input_Cell In Range("Data_Area") 把 记录 区 域 置 空 
Input_Cell.NumberFormatLocal = "@" "将 当前 单元 格 数据 格式 设置 为 常用 
Input_Cell.Value = "" ' 设 置 当前 单元 格 值 为 空 

Next 

Sheets(" 员 工 档案 卡 ").Image1.Picture = LoadPicture("") "清空 相片 控件 

Sheet_Unlock ' 设 定 输入 状态 

Application.ScreenUpdating = True "开启 应 用 程序 刷新 

End Sub 


8.3.3 ”记录 修改 操作 


当 修 改 记录 数据 时 ， 需 要 完成 一 些 初 始 工 作 ， 包 括 设置 当 
前 查询 状态 、 解 锁 工 作 表 保 护 、 重 置 单元 格格 式 以 及 将 单元 格 
的 公式 转换 为 实际 值 等。 修改 记录 操作 的 操作 步骤 如 图 8-14 
所 示 。 以 下 是 该 过 程 的 详细 代码 解释 : 图 8-14 ”修改 记录 操作 步骤 
路 改 记录 
Sub Data_Modify() 
"设置 当前 为 非 查询 状态 
Find_Status = False 
Application.ScreenUpdating = False "关闭 工作 表 刷 新 
ActiveSheet.Unprotect "解除 工作 表 保 护 
' 重 置 记录 单元 格格 式 与 数据 
For Each Input_Cell In Range("Data_Area") 
Input_Cell.NumberFormatLocal = "@" "设置 单元 格格 式 
Input_Cell.Value = Input_Cell.Value "去 公式 ， 置 值 
Next 
Sheet_Unlock 
Application.ScreenUpdating = True "关闭 工作 表 刷 新 
Picture_Load ' 显 示 图 片 
End Sub 


8.3.4 记录 删除 操作 


进行 记录 删除 操作 前 ， 需 要 确认 当前 为 非 查询 状态 、 检 查 当 前 是 否 有 浏览 记录 。 在 进行 
删除 操作 前 ， 根 据 库 表 中 的 记录 行 数 确 认 是 否 有 可 能 完成 删除 操作 。 如 图 8-15 所 示 的 是 该 过 
程 的 执行 流程 。 
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= 一 盘 测 工作 表 是 否 有 浏览 记录 ? 
是 


获取 当前 记录 行 的 位 置 Current Row 
获取 库 表 中 最 大 记录 行 数 Large_ Row 


删除 库 表 记录 行 
库 表 前 翻 一 条 显示 记录 


图 8-15 删除 记录 过 程 流程 
以 下 是 该 过 程 的 详细 代码 解释 : 


删除 记录 
Sub Data_Del() 
Dim Yn As Integer 


If Find_Status = True Then End "确认 当前 为 非 查 询 状态 
If Range("B2").HasFormula = False Then End "检查 当前 是 否 有 浏览 记录 
Current_Row = Worksheets(" 参 数 ") .Range("a3").Value ' 当 前 记录 行 的 位 置 
Large_Row = Worksheets(" 库 ").UsedRange.Rows.Count ' 库 表 中 最 大 记录 行 数 
If Large_Row >= 2 Then 判断 记录 是 否 为 空 

' 提 示 是 否 删除 记录 

Yn = MsgBox(" 确 定 删除 当前 记录 吗 ", vbOKCancel, "删除 记录 ") 

IfYn=1Then 

' 将 库 表 中 对 应 的 记录 行 删除 


Worksheets(" 库 ").Rows(Current_Row & ":" & Current_Row).Delete Shift:=xIUp 
将 员工 档案 卡 显示 的 记录 指向 上 一 条 
Data_PageUp ' 前 翻 一 条 记录 
End If 
Else 
MsgBox "对 不 起 ,没有 记录 可 以 删除 " 
End 
End If 
End Sub 
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8.3.5 ”记录 保存 操作 


单 击 【保存 】 按 钮 后 ， 同 前 面 的 按钮 一 样 ， 也 会 首先 检测 当前 的 状态 ， 以 确定 是 否 需 要 完 
成 保存 操作 ,然后 把 主页 工作 表 的 数据 保存 到 资料 工作 表 中 。 该 过 程 的 流程 图 如 图 8-16 所 示 。 


TO 
是 


输入 资料 不 空 ? 


获取 第 一 个 输入 数据 的 单元 格 对 象 Input_Cell 


一 fot Cell 非 Data_Area 最 后 一 个 单元 稿 了 ~ 


是 


将 Input_Cell 单 元 格 的 值 储 存在 库 表 
Current_Row 和 Current_Col 单 元 格 中 


Data_Area 中 下 一 个 单元 格 


锁定 工作 表 


显示 当前 员工 图 片 


图 8-16 ”记录 保存 过 程 流 程 图 


以 下 是 该 过 程 的 详细 代码 解释 : 

' 保 存 记录 

Sub Data_Save() 
IfFind_Status = True Then End 
If Range("B2").HasFormula = True Then End 
Application.ScreenUpdating = False 
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ActiveSheet.Unprotect 


Current_Row = Worksheets(" 参 数 ").Range("a3").Value ”获得 当前 记录 行 号 
Current Col=1 
"判断 输入 资料 是 否 为 空 
If Application.WorksheetFunction.CountA(Range("Data_Area")) > 2 Then 
"循环 ， 把 每 一 个 数据 保存 到 资料 工作 表 中 
For Each Input_Cell In Range("Data_Area") 
With Worksheets(" 库 ") 
.Cells(Current Row, Current Col).Value = Input_ Cell.Value 
End With 
Input_Cell.NumberFormatLocal = "G/ 通 用 格式 " 
Input_Cell.FormulaR1C1 = "=OFFSET( 库 IR1C" & Current_Col & ", 参 数 IR2C1,0,,)" 
Current_Col = Current Col+ 1 
Next 
Sheet Lock 
Picture_Load ' 显 示 图 片 
Else 
Sheet_Unlock 
Endif 
Application.ScreenUpdating = True 
End Sub 


8.3.6 ”记录 复制 /粘贴 操作 


记录 的 复制 与 粘贴 操作 是 为 了 方便 记录 的 新 增 而 设 的 。 有 时 候 新 员工 的 部 分 资料 可 能 与 
已 建立 资料 的 某 员工 资料 一 致 ， 此 时 可 以 使 用 复制 /粘贴 操作 快速 建立 员工 资料 。 复 制 记录 按 
钮 过 程 十 分 简单 ， 只 需要 保存 当前 显示 员工 的 记录 号 即 可 。 粘 贴 时 直接 使 用 该 保存 值 确定 需 
要 复制 的 记录 所 在 行 号 。 以 下 是 这 些 事件 代码 的 详细 解释 : 
Sub Data_Copy() ' 复 制 记录 
If Find_Status = True Then End 
' 将 当前 显示 员工 的 行 号 记录 到 参数 表 中 
With Worksheets(" 参 数 ") 
.Range("a4").Value = .Range("a3").Value "保存 当前 显示 员工 所 在 行 号 
End With 
End Sub 


Sub Data_Paste() ' 粘 贴 记 录 
Dim Yn As Integer 
If Find_Status = True Then End 
If Range("B2").HasFormula = True Then End 
Application.ScreenUpdating = False 
Current_Row = Worksheets(" 参 数 ").Range("a4").Value ”“' 获 得 当前 记录 行 号 
Current_Col=1 
"判断 输入 资料 是 否 为 空 
If Application.WorksheetFunction.CountA(Range("Data_Area")) > 2 Then 
"当前 显示 有 记录 时 ， 提 示 是 否 覆 盖 数 据 
Yn = MsgBox(" 当 前 记录 已 有 数据 存在 ,覆盖 吗 ", vbOKCancel, "粘贴 记录 ") 
' 当 用 户 确认 覆盖 数据 时 ， 从 库 表 中 获取 数据 覆盖 到 表 中 
lfYn = 1 Then 
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ActiveSheet.Unprotect 
For Each Input_Cell In Range("Data_Area") 
Input_Cell.Value = Worksheets(" 库 ").Cells(Current_Row, Current_Col).Value 
Current_Col = Current Col+ 1 
Next 
Sheet Unlock 
Picture_Load ' 显 示 图 片 
End If 
Else 
ActiveSheet.Unprotect 
For Each Input_Cell In Range("Data_Area") 
Input_Cell.Value = Worksheets(" 库 ").Cells(Current_Row, Current_Col).Value 
Current_Col = Current Col+1 
Next 
Sheet_Unlock 
Picture_Load ' 显 示 图 片 
End 上 f 
Application.ScreenUpdating = True 
End Sub 


8.3.7 ”Sheet_Formula 过 程 


Sheet Formula 过 程 用 于 给 设计 员工 档案 表 Data_Area 中 各 个 单元 格 赋予 公式 。 这 些 公式 
可 以 从 库 表 中 获取 用 户 浏览 员工 的 信息 。 该 公式 通过 一 个 Offset 函数 获取 这 些 信息 。 该 函数 
以 库 表 第 一 行 、 第 Current_Col 列 为 基准 ， 向 下 偏 移 一 个 指定 值 。 该 指定 值 随 着 用 户 单 击 【 浏 
览 】 按 钮 而 发 生变 化 。 公 式 也 会 根据 该 值 使 员工 档案 卡 当 前 显示 的 员工 记录 发 生变 化 。 该 过 
程 的 流程 图 如 图 8-17 所 示 。 


设置 当前 处 于 非 查询 状态 


解除 员工 档案 卡 表 保 护 
获取 Data_ Area 中 首 个 单元 格 Input_Cell 


一 一 aput Ce:;; 单 元 格 非 Data Area 最 后 一 个 单元 格 了 


是 


设置 Input_Cell 单 元 格 公式 
Current Col= Current Col+1 


Data_Area 单 元 格 区 域 中 下 一 个 单元 格 


图 8-17 ”Sheet_Formula 过 程 流程 图 
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以 下 是 该 过 程 的 详细 代码 解释 : 
输入 区 域 赋予 公式 
Sub Sheet_Formula() 
Find_Status = False 
Application.ScreenUpdating = False 
Current Col=1 
ActiveSheet.Unprotect 
For Each Input_Cell in Range("Data_Area") 
Input_Cell.NumberFormatLocal = "G/ 通 用 格式 " 
' 将 库 表 中 的 数据 通过 引用 到 员工 资料 中 
"nput_Cell 单元 格 获取 的 值 为 以 库 表 第 一 行 、 第 Current_Col 列 为 基准 ， 向 下 偏 移 参数 表 中 A2 
单元 格 值 的 行 后 获得 的 那个 单元 格 的 值 
Input_Cell.FormulaR1C1 = "=OFFSET( 库 IR1C" & Current_Col & ", 参 数 !IR2C1,0,,)" 
' 将 列 偏 移 量 增加 1 
Current_Col = Current Col+ 1 
Next 
Sheet_Lock 
Application.ScreenUpdating = True 
End Sub 


8.3.8 记录 浏览 操作 


浏览 记录 的 功能 是 通过 4 个 按钮 共同 完成 的 ， 这 些 按钮 包括 首 笔 、 前 翻 、 后 翻 和 林 笔 。4 
个 按钮 的 功能 分 别 通过 各 自 的 过 程 代 码 完 成 ， 其 中 首 笔 与 末 笔 过 程 的 流程 、 前 翻 与 后 翻 过 程 
的 流程 相差 不 大 ， 因 而 后 面 加 以 介绍 时 ， 只 给 出 首 笔 和 前 翻 的 流程 图 。 以 下 是 这 4 个 按钮 的 
功能 以 及 实现 过 程 描述 ， 

1. 首 笔 按 钮 过 程 

当 用 户 在 员工 档案 卡 工作 表 中 单 击 【 首 笔 】 按 钮 后 ， 表 中 显示 的 记录 将 更 换 为 第 一 个 员 
工 的 信息 。 如 果 工 作 表 中 所 有 显示 员工 信息 的 单元 格 内 具有 链接 公式 ， 此 时 只 需要 修改 参数 
表 A2 单 元 格 中 存储 的 单元 格 偏 移 量 即 可 以 更 新 工作 表 中 所 有 的 员工 信息 。 如 果 没 有 链接 公式 ， 
此 时 通过 调用 Sheet Formula 过 程 向 工作 表 中 写 入 公式 。 该 过 程 的 流程 图 如 图 8-18 所 示 。 


及 单元 格 是 否 有 链接 和 KZ 过 
调用 Shect_Formula 过 程 设置 记录 单元 格 的 链接 公式 
Current Row =1 


将 Current Row 保存 到 参数 工作 表 
加 载 员工 照片 


图 8-18 【 首 笔 】 按 钮 单 击 事件 过 程 流程 图 


EA 


办 公 应 用 意 党 之 多 


Excel VBA 应 用 开发 经 典 案例 


2. 前 翻 按 钮 过 程 

【前 翻 】 按钮 被 单 击 时 ,员工 档案 卡 工作 表 显 示 的 员工 记录 将 移动 到 上 一 条 。 首 先 程 序 检 
测 工 作 表 中 显示 信息 单元 格 是 否 有 链接 公式 ， 然 后 获取 先前 显示 记录 的 行 偏 移 数 并 根据 该 变 
量 的 大 小 决定 是 否 进行 前 翻 操作 。 当 该 值 大 于 或 等 于 2 时 ， 程 序 将 允许 前 翻 ， 并 把 行 偏 移 值 
减 去 1 保存 该 值 。 最 后 ,程序 调用 Picture Load 过 程 将 前 翻 后 的 员工 的 图 片 显示 出 来 。 该 过 程 


的 流程 图 如 图 8-19 所 示 。 
A 


是 


从 参数 表 中 获取 当前 记录 行 的 行 号 Current_Row 


保存 记录 行 号 
显示 当前 员工 的 图 片 


图 8-19 【前 翻 】 按 钮 单 击 事件 过 程 流程 图 


3. 后 翻 按钮 过 程 

【后 翻 】 按 钮 被 单 击 时 ， 员 工 档案 卡 工 作 表 显示 的 员工 记录 将 移动 到 下 一 条 。 

首先 程序 检测 工作 表 中 显示 信息 单元 格 是 否 有 链接 公式 ， 然 后 获取 先前 显示 记录 的 行 偏 
移 数 以 及 库 表 员工 记录 的 最 大 偏 移 量 。 根 据 这 两 个 变量 的 大 小 关系 决定 是 否 进行 后 翻 操作 。 
当 行 偏 移 值 小 于 等 于 最 大 偏 移 时 ， 程 序 将 允许 后 翻 ， 并 把 行 偏 移 值 加 上 1 并 保存 该 值 。 最 后 ， 
程序 调用 Picture_Load 过 程 将 后 翻 后 的 员工 的 图 片 显示 出 来 。 

4. 末 笔 按钮 过 程 

当 用 户 在 员工 档案 卡 工 作 表 中 单 击 【 末 笔 】 按 钮 后 ， 表 中 显示 的 记录 将 更 换 为 末 条 员工 
的 信息 。 如 果 工 作 表 中 所 有 显示 员工 信息 的 单元 格 内 具有 链接 公式 ， 此 时 只 需要 修改 参数 表 
A2 单元 格 中 存储 的 单元 格 偏 移 量 即 可 以 更 新 工作 表 中 所 有 的 员工 信息 。 如 果 没 有 链接 公式 ， 
此 时 通过 调用 Sheet Formula 过 程 向 工作 表 中 写 入 公式 

以 下 是 这 些 过 程 的 详细 代码 解释 : 

' 首 笔记 录 

Sub Data_First() 

' 如 果 单 元 格 不 包含 公式 ， 执 行 Sheet_Formula 转换 公式 过 程 


If Range("B2").HasFormula = False Then Sheet_Formula 
"制定 当前 行为 1， 并 且 将 该 值 保存 到 参数 表 中 
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Current Row = 1 

Worksheets(" 参 数 ").Range("a2").Value = Current_Row 

Picture_Load ”显示 图 片 
End Sub 


"向 前 翻 
Sub Data_PageUp() 
"如 果 单 元 格 不 包含 公式 ， 执 行 Sheet_Formula 转换 公式 过 程 
If Range("B2").HasFormula = False Then Sheet_Formula 
' 从 参数 表 中 获取 当前 记录 行 的 行 号 
Current_Row = Worksheets(" 参 数 ").Range("a2").Value 
' 当 当前 记录 行 的 行 号 大 于 等 于 2 时 ， 向 前 翻动 记录 才 具 有 意义 
If Current_Row >= 2 Then 
' 将 当前 记录 行 的 行 号 指向 即将 显示 记录 的 行 号 
Current_Row = Current Row -1 
"保存 记录 行 号 
Worksheets(" 参 数 ").Range("a2").Value = Current_Row 
Picture_Load ' 显 示 图 片 
Else 
MsgBox "已 到 最 前 面 的 记录 了 
End If 
End Sub 


' 向 后 翻 
Sub Data_PageDown() 
"如 果 单 元 格 不 包含 公式 ， 执 行 Sheet_Formula 转换 公式 过 程 
If Range("B2").HasFormula = False Then Sheet_Formula 
' 从 参数 表 中 获取 当前 行 的 行 号 
Current_Row = Worksheets(" 参 数 ").Range("a2").Value 
' 计 算 员 工 记录 的 最 大 行 
Large_Row = Worksheets(" 库 ").UsedRange.Rows.Count -1 
' 对 比 Current_Row 与 Large_Row 确定 是 否 已 经 位 于 未 笔记 录 
If Current_Row < Large_Row Then 
' 当 没有 到 末 笔 记录 时 ， 将 Current_Row 累加 1， 并 将 该 值 保存 在 参数 表 中 
Current_Row = Current Row + 1 
Worksheets(" 参 数 ").Range("a2").Value = Current_Row 
Picture_Load ' 显 示 图 片 
Else 
MsgBox "已 到 最 后 面 的 记录 了" 
End If 
End Sub 


' 示 笔记 录 

Sub Data_Last() 
"如 果 单 元 格 不 包含 公式 ， 执 行 Sheet_Formula 转换 公式 过 程 
If Range("B2").HasFormula = False Then Sheet Formula 


Current_Row = Worksheets(" 库 ").UsedRange.Rows.Count -1 获得 末 笔 记录 

Worksheets(" 参 数 ").Range("a2").Value = Current_Row 

Picture_Load ' 显 示 图 片 
End Sub 
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办 公 应 用 意 党 之 多 
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8.3.9 记录 的 查询 操作 


记录 的 查询 工作 分 为 3 个 步骤 : 首先 是 单 击 【 查 询 】 按 钮 时 ， 初 始 化 查询 状态 ;然后 通 
过 工作 表 改 变 事件 激发 查询 过 程 ， 最 后 通过 查询 过 程 获取 查询 结果 ， 将 查询 结果 显示 到 员工 
档案 卡 表 中 。 工 作 表 改 变 事件 过 程 参见 员工 档案 卡 表 代码 设计 一 节 。 本 小 节 只 包含 了 整个 查 
询 过 程 的 中 首尾 两 个 过 程 代 码 。 以 下 是 这 两 个 过 程 功能 的 说 明 : 

1. 查询 初始 化 过 程 

当 单 击 【 查 询 】 按 钮 后 ， 系 统 需 要 完成 众多 的 初始 化 操作 ， 以 便于 程序 获取 查询 条 件 并 
存储 。 程 序 需 要 解锁 工作 表 、 置 空 输入 单元 格 、 清 空 Image 控件 显示 以 及 设置 Find_Status 变 
量 为 真 。Find_Status 变量 用 于 标记 当前 正 处 于 查询 的 员工 记录 状态 ， 以 区 别 于 浏览 和 编辑 。 
如 图 8-20 所 示 的 是 该 过 程 的 流程 图 。 


解除 工作 表 保护 
获取 Data_Area 中 第 一 个 单元 格 区 域 Input_Cell 


图 8-20 ”查询 初始 化 过 程 流程 图 

2. 查询 记录 过 程 

该 过 程 接受 两 个 参数 : 一 个 是 查询 信息 在 库 表 所 在 列 的 标题 单元 格 地 址 myAddress， 另 一 
个 是 查询 的 值 Find_Value。 在 员工 档案 卡 工作 表 中 , 每 个 输入 信息 单元 格 左 侧 的 提示 单元 格 的 
值 都 是 链接 到 库 表 的 ， 因 而 要 获取 myAddress， 只 需要 读 取 查询 条 件 输入 单元 格 左 侧 单元 格 的 
公式 即 可 。 

由 于 查询 过 程 的 流程 比较 复杂 ， 这 里 将 详细 介绍 该 过 程 的 流程 ， 程 序 首先 根据 myAddress 
参数 获取 查询 列 列 标题 单元 格 对 象 ， 然 后 对 该 列 进行 排序 ， 以 加 快 查询 速度 。 接 着 通过 Find 
方法 在 该 列 中 找到 等 于 该 值 的 单元 格 。 当 找到 该 单元 格 时 ， 记 忆 下 该 单元 格 的 行 号 ， 并 通过 
Sheet_Formula 过 程 将 查询 到 的 员工 信息 显示 出 来 并 显示 该 员工 的 图 片 ， 最 后 标记 处 于 非 查 询 


状态 。 当 未 找到 记录 时 ， 提 示 未 找到 记录 并 标记 当前 处 于 查询 状态 。 如 图 8-21 所 示 的 是 查询 
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解除 工作 表 保 护 
获取 Data_Area 中 第 一 个 单元 格 区 域 Input_Cell 


put_Cell 非 Data_Area 最 后 一 个 单元 格 7 一- 一 


是 


设置 单元 格 区 域 mput Cell 格式 及 值 


下 一 个 单元 格 区 域 


设置 查询 状态 
图 8-21 查询 记录 过 程 流程 图 
以 下 是 这 两 个 过 程 的 详细 代码 解释 : 
查询 初始 化 过 程 
Sub DataFind_Status() 
Application.ScreenUpdating = False 
ActiveSheet.Unprotect 
For Each Input_Cell In Range("Data_Area") 
Input_Cell.NumberFormatLocal = "@" 
Input_Cell.Value = "" ' 置 空 值 


Next 
Sheets(" 主 页 ").Image1.Picture = LoadPicture("") "相片 为 空 
Sheet_Unlock 
Application.ScreenUpdating = True 
Find_Status = True 
End Sub 


执行 记录 查询 
Sub Data_Search(myAddress, Find_Value As String) 
Dim Find_range As Range 


Application.ScreenUpdating = False "设置 屏幕 不 更 新 
On ErrorResume Next 
Set Find_range = Range(myAddress) "依据 传递 的 参数 获取 一 个 单元 格 对 象 


Application.Goto Find_range 
' 将 库 表 按 照 Find_Range 单元 格 所 在 列 排序 ， 排 序 方式 按照 拼音 ， 顺 序 为 升序 
With Worksheets(" 库 ") 
.Range("a1:" & .UsedRange.Address).Sort Key1:=Range(Find_range.Address), 
Order1:=xlAscending, Header=xlGuess, OrderCustom:=1, MatchCase _ 
:=False, Orientation:=xITopToBottom, SortMethod:=xIPinYin, DataOption1:=xlSortNormal 
End With 
With Worksheets(" 库 ").Columns(Find_range.Column) 
' 在 库 表 的 Find_Range 单元 格 所 在 列 查找 包含 Find_Value 的 单元 格 
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Set Find_range = .Find(Find_Value, Lookln:=xlValues, SearchOrder:=xlByRows) 
If Not Find_range ls Nothing Then 
' 当 找到 对 应 单元 格 后 ， 将 该 单元 格 的 记录 行 号 保存 到 参数 表 中 
Worksheets(" 参 数 ").Range("a2").Value = Find_range.Row - 1 
' 刷 新 员工 档案 卡 表 中 的 公式 
Sheet_Formula 
' 设 置 非 查 询 状 态 
Find_Status = False 
Picture_Load ' 显 示 图 片 
Else 
' 当 没 找到 对 应 单元 格 时 ， 继 续 查询 并 提示 未 找到 记录 
Find_Status = True 
Range("b2").Select 
MsgBox "对 不 起 , 找 不 到 相符 的 记录 ,请 重新 输入 " 
End If 
End With 
Application.ScreenUpdating = True 
End 
End Sub 


8.3.10 ”锁定 与 解锁 工作 表 过 程 


员工 档案 卡 工作 表 在 浏览 状态 下 ， 输 入 单元 格 处 于 锁定 状态 。 当 用 户 浏览 员工 信息 时 ， 
需要 锁定 na th 的 误 操 作 ， 造 成 数据 修改 。 当 用 户 需 要 编辑 员工 信息 时 ， 又 需 
要 解锁 工作 表 输 入 单元 格 。 锁 定 与 解锁 工作 表 过 程 分 别 完成 这 两 个 任务 。 

这 两 个 过 程 的 流程 十 ws 仅仅 操作 工作 表 锁 定 状 态 时 ， 分 别 进行 相反 的 设置 。 这 里 
只 对 解锁 工作 表 过 程 加 以 说 明 。 解 锁 时 ， 程 序 首先 需要 解除 工作 表 的 保护 ， 然 后 依次 循环 
Input_Area 名 称 包含 的 所 有 单元 格 。 es 单元 格 ， 都 设置 Locked 属性 为 假 。 
为 了 保证 只 有 那些 刚 解锁 的 单元 格 能 编辑 ， 程 序 还 需要 重新 开启 工作 表 保 护 ， 并 且 设置 解锁 
单元 格 可 选 。 如 图 8-22 所 示 的 是 解锁 工作 表 过 程 的 流程 图 。 


解除 工作 表 保护 
获取 Input Area 名 称 中 第 一 个 单元 格 区 域 Input_Cell 


put_Cell 是 否 为 Input_Area 最 后 一 个 单元 格 区 


一 一 一 一 Cell 
Input Cell 指向 下 一 个 单元 格 区 域 


开启 工作 表 保 护 并 设置 解锁 单元 格 区 域 可 选 定 


图 8-22 解锁 工作 表 过 程 流程 图 
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以 下 是 锁定 和 解锁 工作 表 过 程 的 详细 代码 解释 : 


"解锁 工作 表 
Sub Sheet_Unlock() 
Range("b2").Select 
"解除 工作 表 保 护 
ActiveSheet.Unprotect 
"循环 所 有 需 输入 的 单元 格 ， 解 除 单元 格 的 锁定 状态 
For Each Input_Cell In Range("Input_Area") 
If Input_Cell.MergeCells = True Then 
Input_Cell.MergeArea.Locked = False 
Else 
Input_Cell.Locked = False 
End If 
Next 
' 重 新 开启 工作 表 保 护 
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
"设置 在 工作 表 中 可 以 被 选择 单元 格 只 能 是 已 经 解除 锁定 的 单元 格 
ActiveSheet.EnableSelection = xlUnlockedCells 
End Sub 


锁定 工作 表 
Sub Sheet Lock() 
Range("a1").Select 
ActiveSheet.Unprotect 
For Each Input_Cell In Range("Data_Area") 
If Input_Cell.MergeCells = True Then 
Input_Cell.MergeArea.Locked = True 
Else 
Input_Cell.Locked = True 
End If 
Next 
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
ActiveSheet.EnableSelection = xlUnlockedCells 
End Sub 


8.3.11 隐藏 批注 与 显示 图 片 过 


隐藏 批注 与 显示 图 片 过 程 都 和 员工 图 片 信息 相关 。 在 员工 档案 卡 工 作 表 中 ， 用 户 的 图 像 
通 道 过 一 个 Image 控件 显示 ， 当 鼠标 指针 在 该 控件 滑 过 时 ， 存储 员工 图 片 位 置 的 G2 单元 格 的 批 
主 会 显示 出 来 。 该 批注 不 会 自动 隐藏 ， 当 鼠标 指针 移 开 Image 控件 时 ， 需 要 将 该 批注 隐藏 起 
这 就 是 隐藏 批注 的 功能 。 
显示 图 片 过 程 从 员工 档案 卡 工作 表 的 G2 单元 格 获取 员工 图 片 地 址 , 并 且 按 该 地 址 找到 该 
图 片 加 载 到 Image 控件 中 。 当 G2 单元 格 没有 任何 地 址 信息 时 , 程序 将 清除 Image 控件 的 显示 。 
这 两 个 过 程 的 代码 与 流程 都 不 复杂 ， 以 下 不 再 给 出 过 程 的 流程 图 。 下 面 是 两 个 过 程 的 详细 代 
码 解释 : 
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' 隐 藏 批注 
Sub Hidden_Comment() 
"设置 任何 时 候 都 不 显示 批注 与 标识 符 
Application.DisplayCommentlndicator = xINolndicator 
"设置 不 显示 图 像 控 件 所 在 单元 格 的 批注 
Sheets(" 员 工 档案 卡 ").Range("g2").Comment.Visible = False 
End Sub 


显示 图 片 
Sub Picture_Load() 
On Error GoTo LoadPicture_Err 
' 当 没有 任何 错误 发 生 时 ， 在 图 像 控件 中 装载 G2 单元 格 指定 路 径 的 图 像 ， 否 则 清空 图 像 控件 
Sheets(" 员 工 档案 卡 ").Image1.Picture = LoadPicture(Range("g2").Value) 
Exit Sub 
LoadPicture_Err: 
Sheets(" 员 工 档案 卡 ").Image1.Picture = LoadPicture("") 


End Sub 


8.4 考勤 签到 模块 代码 设计 


考勤 签到 模块 用 于 向 当月 考勤 表 登 记 员工 出 勤 情况 。 考 勤 表 的 样式 在 前 面 章节 已 经 介绍 ， 
该 节 将 讲述 该 部 分 的 功能 实现 。 


8.4.1 考勤 签到 窗 体 设计 


员工 签到 时 可 以 通过 该 窗 体 了 解 当前 的 系统 时 间 ， 从 【员工 名 】 Eee 
F 拉 列表 中 选择 自己 的 名 字 , 如果 员 工 名 称 有 重复 时 , 可 以 参考 员工 。 szs: 


号 选择 。 该 窗 体 的 界面 如 图 8-23 所 示 。 窗 体 主要 包括 系统 时 间 显示 。 “G3 
ed bn et i ED] ”| 
标签 、 员 工 号 显示 标签 、 员 工 名 选择 列表 、 签到 按钮 和 关闭 窗 体 按钮 。 

该 窗 体 的 制作 步骤 如 下 : 图 8-23 考勤 签到 界面 


(1) 在 Excel 2007 的 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 插入 一 个 用 
户 窗 体 。 随 后 在 【属性 】 窗 口中 设置 该 窗 体 的 名 称 属性 为 “frm 考勤 ”，Caption 属性 设置 为 
“考勤 签到 ”。 

(2) 在 控件 工具 箱 中 选择 标签 按钮 控件 。 在 窗 体 中 单 击 鼠 标 左 键 并 拖 动 以 产生 适当 大 小 
的 标签 。 随 后 将 该 控件 再 复制 4 份 。 然 后 在 【属性 】 窗 口中 将 第 一 个 标签 的 Caption 属性 设置 
为 “当前 时 间 : ”。 第 二 个 标签 的 Caption 属性 设置 为 空 ， 并 将 其 名 称 修改 为 “lab 时 间 ”。 

(3) 在 属性 窗口 中 将 第 三 个 标签 的 Caption 属性 设置 为 “员工 号 : ”。 第 四 个 标签 的 
Caption 属性 设置 为 空 ， 并 将 该 其 名 称 修改 为 “lab 员工 名 ”。 

(4) 在 属性 窗口 中 将 第 五 个 标签 的 Caption 属性 设置 为 “员工 名 : ”。 随 后 在 控件 工具 
箱 中 选择 组 合 框 控件 。 在 窗 体 中 单 击 鼠 标 左 键 并 拖 动 以 产生 适当 大 小 的 组 合 框 。 然 后 在 【 属 
性 】 窗 口中 将 其 名 称 设置 为 “comb 员工 名 ”。Style 属性 设置 为 2-frmStyleDropDownList， 此 
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项 设置 将 导致 该 组 合 框 不 接受 用 户 输入 内 容 。SelectionMargin 属性 设置 为 False， 此 项 设置 将 
使 该 组 合 框 文本 区 没有 留 白 。 

(5) 按照 步骤 (4) 相同 的 方法 向 窗 体 再 添加 两 个 按钮 控件 。 随 后 在 属性 窗口 中 设置 第 
一 个 按钮 的 Caption 属性 为 “签到 ”， 名 称 属 性 设置 为 “btn 签到 ”。 第 二 个 按钮 的 Caption 属 
性 设置 为 “关闭 ”， 名 称 属性 设置 为 “btn 关闭 ”。 

(6) 调整 各 个 控件 的 排列 位 置 并 调整 窗 体 大 小 。 将 各 个 控件 的 位 置 及 大 小 调整 成 如 图 8-23 
所 示 。 

表 8-1 列 出 了 该 窗 体 中 与 代码 相关 的 各 个 控件 及 其 功能 解释 。 

表 8-1 考勤 签到 窗 体 控件 列表 
名 称 | 控件 类 型 功能 解释 
lab 时 间 标签 控件 “| 用 于 显示 当前 系统 时 间 
lab 员工 号 标签 控件 “| 用 于 显示 当前 选择 的 员工 的 员工 号 
comb 员工 名 | 复合 框 控件 | 用 于 获取 员工 名 , 该 列表 允许 员工 名 相同 ， 相 同 的 员工 名 通过 员工 号 加 以 区 分 


btn 签到 按钮 控件 _ | 选择 该 按钮 后 ， 完 成 当前 选择 员工 的 签到 工作 
btn 关闭 按钮 控件 _ | 选择 该 按钮 后 ， 退 出 考勤 签到 窗 体 


8.4.2 考勤 签到 模块 执行 流程 与 初始 化 代码 


考勤 签到 时 ， 员 工 首先 选择 员工 名 ， 当 有 重复 名 时 ， 
员工 通过 员工 号 校正 员工 名 的 选择 ,直到 选择 正确 的 员工 
名 为 止 。 接 着 单 击 【 签 到 】 按钮 ， 系 统 根据 签到 时 间 ， 判 
断 员 工 出 勤 情况 ， 并 将 其 记录 到 考 吉 表 中 。 此 处 记录 的 出 
勤 情况 包括 出 勤 、 旷 工 和 迟到 3 种 情况 。 图 8-24 列 出 了 
考勤 签到 时 相应 代码 的 执行 过 程 。 


该 流程 可 以 通过 窗 体 的 初始 化 事件 过 程 代 码 中 看 出 ， 
以 下 是 该 窗 体 的 初始 化 代码 : 


Private Sub UserForm _lInitialize() 
Dim intRow As Integer 


图 8-24 考勤 签到 窗 体 程序 执行 流程 图 


hMain = FindWindow(vbNullString, Me.Caption) "获取 窗口 句柄 

StartTimer "建立 计时 器 并 显示 时 间 到 时 间 标 签 控件 
检查 考勤 月 份 ' 检 查考 勤 月 份 

考勤 表 检 查 ' 检 查考 勤 表 员工 资料 

intRow = Sheets(" 库 ").UsedRange.Rows.Count "获取 库 表 中 已 用 数据 区 域 行 数 
comb 员工 名 .RowSource = " 库 !B2:B" & intRow "初始 化 员工 名 列表 框 内 容 

下 面 代码 将 考勤 表 激 活 ， 并 且 将 活动 单元 格 定位 到 A1 

Sheets(" 考 勤 表 ").Select 

Sheets(" 考 勤 表 ").Range("A1").Select 

End Sub 

代码 说 明 : 


口 _hMain 公共 变量 用 于 获取 窗口 句柄 ， 该 参数 将 被 StartTimer 所 调用 ， 以 便于 为 该 窗 体 
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办 公 应 用 非常 之 稍 


Excel VBA 应 用 开发 经 典 案例 


创建 一 个 计时 器 。 

口 系统 的 考勤 表 是 按照 月 来 记录 的 ， 所 以 当当 前 日 期 与 考勤 表 的 月 份 不 一 致 时 ， 应 该 
建立 新 的 考勤 表 。 这 就 是 检查 考勤 月 份 过程 的 工作 。 

口 考勤 表 中 的 员工 资料 可 能 与 库 表 中 员工 资料 不 一 致 。 这 可 能 是 由 于 员工 辞职 ， 库 表 
删除 了 该 员工 ， 也 可 能 是 刚 有 新 员工 加 入 ， 库 表 添 加 了 新 员工 资料 ， 也 可 能 是 某 位 
员工 的 员工 名 输入 错误 ， 在 库 表 中 修改 了 该 员工 的 员工 名 。 考 勤 表 检查 过 程 将 检查 
这 些 ， 并 将 考勤 表 的 员工 资料 加 以 修正 。 

口 员工 名 列表 的 内 容 是 通过 该 控件 的 Rowsource 属性 链接 到 库 表 而 获得 的 。 指 定 该 属 
性 时 ， 需 要 指出 链接 区 域 的 详细 位 置 ， 此 处 链接 的 是 库 表 B 列 中 所 有 员工 名 区 域 。 
链接 字符 串 的 格式 一 般 为 : 表 名 +!+ 区 域名 。 

口 ” 当 该 窗 体 初始 化 后 ， 需 要 激活 考勤 表 ， 以 便于 员工 了 解 自 己 的 出 勤 记 录 情 况 。 由 于 
系统 在 生成 该 表 时 ， 可 能 将 活动 单元 格 指定 到 其 他 位 置 ， 造 成 显示 时 位 置 不 正确 
所 以 在 激活 该 表 后 ， 修 正 了 活动 单元 格 的 位 置 。 


8.4.3 设计 计时 器 代码 


窗 体 中 的 时 间 标签 动态 地 显示 当前 的 系统 时 间 ， 签 到 者 可 


以 根据 该 时 间 确 定 自己 当日 的 出 勤 情况 。 标 签 控 件 的 内 容 是 不 


会 自动 更 新 的 ，Excel 的 窗 体 也 没有 定时 器 功能 。 为 了 实现 标签 
控件 现实 时 间 每 过 1 秒 后 更 新 ， 需 要 使 用 定时 器 ， 该 定时 器 是 
通过 API 函数 实现 的 。 通 常 通过 API 函数 使 用 计时 器 时 ， 一 般 
的 方式 可 参考 图 8-25 所 示 。 
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下 面 的 代码 体现 如 图 8-25 所 示 的 流程 : 图 8-25 “计时 器 使 用 过 程 

'API 函数 与 公共 变量 声明 区 域 

'SetTimer 函数 用 于 创建 一 个 计时 器 

Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _ 
ByVal uElapse As Long, ByVal IpTimerFunc As Long) As Long 

'KillTimer 函数 用 于 销毁 由 SetTimer 函数 创建 的 计时 器 

Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvetn As Long) As 

Long 

"FindWindwow 函数 用 于 寻找 所 有 开启 窗口 中 满足 指定 条 件 的 项 级 窗口 

Public Declare Function FindWindow Lib "user32.dl" Alias "FindWindowA" (ByVal lpClassName As String, _ 
ByVal ipWindowName As String) As Long 

' 公 共 变 量 ， 主 窗口 句柄 

Public hMain As Long 


更 新 时 间 显示 过 程 

'SetTime 过 程 修改 考勤 窗 体 的 当前 时 间 标 签 

Sub SetTime() 

frm 考勤 .Lab 时 间 .Caption = Format(Now, "hh:mm:ss") 
End Sub 

建立 计时 器 过 程 


Ah 
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'StartTimer 过 程 调用 SetTimer 函数 创建 一 个 计时 器 
Sub StartTimer() 

SetTimer hMain, 1001, 1000, AddressOf SetTime 
End Sub 


"销毁 计 时 器 
'EndTimer 过 程 调 用 KillTimer 函数 终结 计时 器 
Sub EndTimer() 
KillTimer hMain, 1001 
End Sub 
代码 说 明 : 
(1) 在 API 函数 SetTimer 中 出 现 的 1001 常量 参数 是 生成 的 计时 器 的 标识 ， 在 销毁 该 计 
时 器 时 需要 使 用 该 参数 。 
(2) 在 API 函数 SetTimer 中 出 现 的 1000 常量 参数 指定 了 超时 值 ，1000 即 为 1 秒 ， 该 参 
数 单位 为 毫秒 。 
(3) AddressOf SetTime 语句 获取 了 函数 SetTime 的 地 址 信息 。 该 地 址 信息 被 传递 给 API 
函数 SetTimer 后 ， 将 会 造成 每 隔 1 秒 时 ， 系 统 调用 一 次 SetTime 函数 。 
(4) 上 面 的 代码 并 不 能 立即 发 挥 计 时 器 的 作用 ， 计 时 器 要 正常 工作 还 需要 事件 的 触发 。 这 
里 所 指 的 事件 触发 即 为 窗 体 的 初始 化 事件 ， 在 窗 体 初 始 化 事件 中 建立 计时 器 ， 在 计时 器 工作 
中 执行 SetTime 过 程 更 新 时 间 显 示 。 当 窗 体 关闭 时 ， 销 毁 计 时 器 。 与 计时 器 相关 的 3 个 工作 流 
程 都 在 窗 体 的 相应 事件 中 执行 。 


8.4.4 设计 检查 考勤 月 份 代码 


在 系统 中 考勤 表 是 按 月 计算 的 。 当 现在 所 处 月 份 与 考勤 表 记 录 的 月 份 不 一 致 时 ， 需 要 将 
该 考勤 表 保存 起 来 ， 并 且 重 新 建立 一 新 考勤 表 。 这 个 任务 由 检查 考勤 月 份 过 程 完成 。 图 8-26 
列 出 了 该 过 程 的 流程 图 。 


一 当前 年 月 与 表 年 月 相 得 


保存 考勤 表 


图 8-26 检查 考勤 月 份 流程 图 
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Excel VBA 应 用 开发 经 典 案例 。 如 1 


该 过 程 的 代码 如 下 : 
' 该 过 程 检 查考 勤 表 是 否 与 当前 月 份 相符 合 ， 当 不 符合 时 ， 建 立新 的 考勤 表 ， 旧 表 重 命名 保存 
Sub 检查 考勤 月 份 () 
Dim strYear As String, strMonth As String 
Dim intRow As Integer, i As Integer, j As Integer 
Dim ws1 As Worksheet, ws2 As Worksheet 
Dim rg As Range 
获取 当前 年 月 
strYear = Format(Now, "yyyy") 
strMonth = Format(Now, "mm") 
' 将 考勤 表 的 年 月 与 当前 年 月 比较 ， 不 一 致 时 保存 该 表 并 重新 建立 该 表 
If strYear = CStr(Sheets(" 考 勤 表 ").Range("AH2")) And strMonth = CStr(Sheets(" 考 勤 表 ").Range 
("AJ2")) Then 
Exit Sub 
Else 
Set ws1 = Sheets(" 考 勤 表 ") 
ws1.Name = "考勤 表 (" & strYear & "-" & Sheets(" 考 勤 表 ").Range("AJ2") & ")" 
Sheets(" 考 勤 表 模板 ").Copy after:=Worksheets(" 考 勤 表 模板 ") 
Set ws2 = ActiveSheet 
' 定 义 新 考勤 表 标 签名 ， 以 及 该 表 记录 考勤 的 年 月 
With ws2 
.Name = "考勤 表 " 
.Range("AH2") = strYear 
.Range("AJ2") = strMonth 
End With 
"获取 库 表 已 使 用 区 域 行 数 
intRow = Sheets(" 库 ").UsedRange.Rows.Count 
' 将 库 表 中 所 有 员工 的 员工 号 、 员 工 名 填写 到 新 考勤 表 
Fori= 2 To intRow 


ws2.Cells(i + 3, 1).EntireRow.Insert "插入 新 行 
ws2.Cells(i + 3, 1) = Sheets(" 库 ").Cells(i, 1) ' 填 入 员工 号 
ws2.Cells(i + 3, 2) = Sheets(" 库 ").Cells(i, 2) ' 填 入 员工 名 
"复制 考勤 统计 部 分 的 公式 

Forj = 34 To 39 


ws2.Cells(i + 4, j).Copy 
ws2.Cells(i + 3, j).PasteSpecial 
Next 
Application.CutCopyMode = False "关闭 剪 切 与 粘贴 模式 
Next 
End If 
获取 旧 考 勤 表 最 后 员工 记录 行 所 在 的 行 号 
intRow = ws1.UsedRange.Rows.Count -1 
检查 上 月 是 否 有 员工 跨 月 请 假 ， 存 在 时 ， 在 当前 月 份 的 考勤 表 中 登记 并 清除 旧 考 勤 表 的 跨 月 请 假 记录 
Fori= 5 To intRow 
Ifws1.Range("AO" &i) > 0 Then ' 检 查 假期 统计 中 的 假期 剩余 
' 在 新 考勤 表 中 找到 该 员工 的 员工 号 单元 格 
Set rg = ws2.Range("A5:A" & intRow).Find(ws1.Range("A" & i) 
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' 在 新 考勤 表 中 标记 该 员工 的 请 假 记录 
Forj = 3 To ws1.Range("AO" &i)+2 
Sheets(" 考 勤 表 ").Cells(intRow, j) = ws1.Range("AN" &i) 
Next 
' 清 除 旧 考勤 表 的 假期 统计 内 容 
ws1.Range("AN" & i & ":AO" & i).ClearContents 
End If 
Next 
End Sub 


代码 说 明 : 
口 ” 首 先 通过 Format 函数 分 别 以 “YYYY”，“MM” 格 式 从 当前 日 期 中 提取 年 与 月 。 
口 检查 考勤 表 的 年 月 是 否 与 当前 日 期 的 年 月 相符 。 如 果 一 致 就 退出 过 程 ， 不 一 致 时 继 


口 将 旧 考 勤 表 的 标签 修改 为 “考勤 表 ”+ “年 -月 ) ”格式 ， 然 后 从 考勤 表 模板 复制 建 
立新 的 考勤 表 。 命 名 新 表 为 “考勤 表 ” 并 填写 当前 年 月 到 表 中 的 年 月 单元 格 。 


口 从 库 表 的 第 二 行 记录 开始 ， 循 环 到 Sheets(" 库 ").UsedRange.Rows.Count 行为 止 。 将 
所 有 行 中 的 员工 号 与 员工 名 写 入 新 考勤 表 中 。 在 该 循环 过 程 中 还 要 重新 填写 考勤 
统计 区 域 的 公式 ， 这 些 公式 已 经 在 考勤 表 的 最 后 一 行 建立 。 例 如 ， 第 五 行 的 出 勤 所 
在 列 的 公式 为 “=COUNTIF(SC5:SAG5," V")”， 关 于 该 公式 的 意义 ， 参见 前 面 知 识 
点 五 。 

口 在 旧 考勤 表 : 中 可 能 记录 了 部 分 跨 月 请 假 时 ， 部 分 没有 标记 请 假 记录 的 信息 ， 这 部 分 

息 需 要 在 当前 月 份 下 标记 。 这 时 ， 需 要 根据 旧 考勤 表 中 记录 的 请 假 类 型 和 假期 剩 

息 在 新 考勤 表 中 加 以 标记 。 

口 标记 跨 月 请 假 时 ， 从 旧 考 勤 表 的 第 五 行 开始 ， 循 环 到 最 后 一 员工 所 在 行 。 当 
wsl.Range("AO" &1i) > 0 为 真 时 ， 可 以 判断 有 中 月 请 假 记录 ， 然后 在 新 考勤 表 中 找到 
对 应 员工 。 通 过 一 个 内 循环 ， 从 新 考勤 表 的 第 三 列 开始 ， 一 直到 假期 的 终结 日 ， 将 
所 有 该 员工 在 这 些 日 期 内 的 考勤 记 为 ws1.Range("AN" &i) 单 元 格 内 容 。 

口 最 后 清除 该 员工 的 假期 统计 信息 。 


8.4.5 设计 检查 考勤 表 员 工资 料 代码 


考勤 表 和 库 表 中 相应 的 员工 号 与 员工 名 可 能 存在 部 分 出 入 。 这 些 可 能 是 由 于 员工 辞职 ， 
库 表 删除 了 该 员工 ;也 可 能 是 刚 有 新 员工 加 入 ， 库 表 添 加 了 新 员工 资料 ， 也 可 能 是 某 位 员工 
的 员工 名 输入 错误 ， 在 库 表 中 修改 了 该 员工 的 员工 名 。 检 查考 勤 表 过 程 将 检查 这 些 问题 ， 并 
将 考勤 表 的 员工 资料 加 以 修正 。 

在 处 理 这 些 问 题 时 ， 有 一 种 情况 不 需要 追究 ， 即 库 表 删 除了 某 员 工 。 不 需要 在 考勤 表 中 
删除 该 员工 ， 因 为 可 能 在 该 月 的 前 一 时 间 段 里 该 员工 的 考勤 记录 仍然 是 真实 的 。 该 过 程 的 流 
程 图 如 图 8-27 所 示 。 


获取 考勤 表 中 员工 数 


图 8-27 检查 考勤 表 流程 图 
该 过 程 的 代码 如 下 : 


' 该 过 程 检 查考 勤 表 和 库 表 的 员工 信息 是 否 一 致 ， 当 新 增 员工 时 ， 在 考勤 表 中 建立 该 员工 资料 
Sub 考勤 表 检查 () 
Dim intRow1 As Integer, intRow2 As Integer, i As Integer 
Dim intEnd As Integer, intStart As Integer, j As Integer 
Dim rgFind As Range 
获取 库 表 中 已 使 用 行 数 
intRow1 = Sheets(" 库 ").UsedRange.Rows.Count 
获取 考勤 表 中 已 使 用 行 数 
intRow2 = Sheets(" 考 勤 表 ").UsedRange.Rows.Count 
' 循 环 检测 对 比 ， 将 库 表 中 新 添加 的 员工 填 入 考勤 表 中 
"对 于 有 删除 员工 的 情况 ， 这 里 不 需要 在 考勤 中 删除 对 应 资料 ， 因 为 可 能 该 员工 在 当前 月 份 可 能 工作 过 一 段 时 间 
Fori= 2 To intRow1 
' 在 考勤 表 中 查找 对 应 员工 的 员工 号 
Set rgFind = Sheets(" 考 勤 表 ").Range("A5:A" & intRow2).Find(Sheets(" 库 ").Range("A" & i)) 
' 当 没有 找到 该 员工 号 时 ， 将 该 员工 资料 建立 到 考勤 表 中 
If rgFind ls Nothing Then 
Sheets(" 考 勤 表 ").Cells(i + 3, 1).EntireRow.Insert 
Sheets(" 考 勤 表 ").Cells(i + 3, 1) = Sheets(" 库 ").Cells(i, 1) 
Sheets(" 考 勤 表 ").Cells(i + 3, 2) = Sheets(" 库 ").Cells(i, 2) 
intRow2 = intRow2 + 1 
Forj= 34 To 39 
Sheets(" 考 勤 表 ").Cells(i + 4,j).Copy 
Sheets(" 考 勤 表 ").Cells(i + 3, j).PasteSpecial 
Next 


Application.CutCopyMode = False 


' 当 已 有 该 员工 号 时 ， 但 员工 名 不 一 致 时 ， 修 改 员 工 名 即 可 
If rgFind.Offset(0, 1) <> Sheets(" 库 ").Cells(i, 2) Then 
rgFind.Offset(0, 1) = Sheets(" 库 ").Cells(i, 2) 


End If 
End 上 
Next 
End Sub 
代码 说 明 : 
口 首先 该 过 程 从 库 表 和 考勤 表 中 获取 了 两 表 中 已 使 用 行 数 ， 这 两 个 变量 在 后 续 循环 比 


口 ”从 库 表 的 第 二 行 开始 , 循环 到 该 表 的 intRowl 行 。 当 在 考勤 表 中 找 不 到 该 员工 时 , 插 
入 新 行 ， 并 在 考勤 表 中 建立 该 员工 的 资料 ， 包 括 员 工 号 与 员工 名 。 为 该 员工 的 考勤 
统计 区 域 复制 统计 公式 ， 然 后 继续 下 一 个 员工 行 。 

口 ” 当 考勤 表 中 查 到 该 员工 号 但 是 员工 名 不 一 致 时 ， 修 改 该 员工 的 员工 名 后 继续 下 一 个 
员工 行 。 


8.4.6 设计 标记 员工 出 勤 代码 


标记 员工 出 勤 的 工作 ， 包 括 标记 正常 出 勤 、 迟 到 和 上 旷工。 前 两 项 是 由 签到 按钮 完成 ， 签 
到 按钮 不 涉及 旷工 情况 。 本 小 节 将 分 别 讲述 【签到 】 按 钮 和 记 旷 工 的 功能 实现 。 

本 系统 的 默认 最 后 签到 时 间 为 早上 9 点 。 在 该 时 间 前 签到 的 员工 为 正常 出 勤 ， 和 否则 为 迟 
到 。 对 于 没有 签到 的 员工 ， 退 出 窗口 时 ， 系 统 将 提示 是 否 记 为 旷工 。 单 击 窗 体 上 的 【签到 】 
按钮 时 ， 将 触发 签到 按钮 单 击 事件 过 程 ， 该 过 程 的 流程 图 如 图 8-28 所 示 。 


图 8-28 【签到 】 按 钮 单 击 事件 过 程 流程 图 
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该 过 程 代码 如 下 : 
Private Sub btn 签到 _Click() 
Dim strName As String, rg As Range 
Dim intRow As Integer, j As Integer 
strName = lab 员工 号 .Caption "获取 员工 号 
' 当 没有 选择 员工 时 ， 退 出 过 程 
IfLen(strName) = 0 Then Exit Sub 
' 在 考勤 表 中 查询 员工 号 
Set rg = Sheets(" 考 勤 表 ").Range("A5").EntireColumn.Find(strName) 
"没有 找到 该 员工 资料 时 退出 过 程 
Ifrg ls Nothing Then 
MsgBox "考勤 表 中 没有 员工 " & strName & "的 资料 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 
Else 
intRow = rg.Row 
j= Day(Now) + 2 
上 Len(Sheets(" 考 勤 表 ").Cells(intRow, j)) Then 
MsgBox "员工 " & strName & "已 经 完成 签到 ! ", vbOKOnly + vblnformation, "提示 " 


Else 
If Time > TimeValue("09:00:00") Then 
Sheets(" 考 勤 表 ").Cells(intRow, j) = " 太 " "标记 为 迟到 
Else 
Sheets(" 考 勤 表 ").Cells(intRow, j) ="V" "标记 为 出 勤 
End If 
End ff 
End If 
End Sub 
代码 说 明 : 
口 ”此 处 在 查询 员工 时 使 用 的 是 员工 的 员工 号 ， 而 不 是 姓名 。 因 为 姓名 有 可 能 一 致 ， 而 
员工 号 不 会 重复 。 


口 程序 从 窗口 的 员工 号 标签 控件 获取 员工 号 ， 然 后 根据 员工 号 字符 串 长 度 确定 窗 体 是 
否 获得 了 员工 名 输入 。 当 没有 输入 员工 名 时 ， 退 出 过 程 ， 然 后 在 考勤 表 中 查询 该 员 
工 号 。 找 到 该 员工 时 ， 首 先 检测 该 员工 是 否 已 经 完成 签到 。 当 有 签到 时 再 检测 签到 
时 间 是 否 超过 时 间 ， 针 对 不 同情 况 ， 标 记 员 工 出 勤 为 迟到 或 出 勤 。 

对 于 在 规定 签到 时 间 没 有 签到 的 员工 ， 需 要 标记 为 旷工 。 这 项 工作 是 在 退出 签到 窗 体 时 ， 
进行 提示 操作 的 。 退 出 窗口 时 ， 程 序 首先 获取 考勤 表 使 用 区 域 行 数 并 计算 当前 日 期 对 应 的 表 
格 列 号 ， 然 后 程序 依次 循环 考勤 表 考 勤 数据 区 域 各 行 ， 查 找 当 前 日 期 下 没 设置 考勤 信息 的 员 
[。 当 发 现 有 未 设置 考勤 的 员工 时 ， 提 示 是 否 记 该 员工 旷工 。 当 用 户 确定 时 ， 程 序 调用 记 旷 
[过 程 完成 标记 员工 旷工 操作 。 

记 上 旷工 过 程 和 窗口 退出 过 程 的 操作 大 体 一 致 ， 只 是 在 找到 有 员工 没有 记 考勤 时 ， 直 接 将 
[的 考勤 记 为 “ 国 ” 即 旷工 。 因 而 下 面 在 给 出 流程 图 时 ， 只 给 出 窗口 的 QueryClose 事件 


一 一 爱 事 表 ;i 行 j 列 未 记 考 : | 
一 一 其 天 记 该 员工 六 了 ?一 一 


i 


图 8-29 QueryClose 事件 过 程 流程 图 


从 上 面 的 流程 图 中 可 以 看 出 程序 在 调用 记 旷 工 过 程 后 ， 直 接 终 止 了 过 程 ， 该 跳 转 避 免 无 
意义 的 循环 。 在 窗口 的 QueryClose 事件 代码 中 通过 循环 来 检测 是 否 存在 员工 没有 记 考勤 。 这 
里 只 需要 检测 到 一 个 员工 未 记 考勤 即 可 ， 不 需要 每 个 都 确认 一 次 ， 而 在 记 旷工 过 程 中 则 遍历 


了 所 有 员 
止 了 过 程 。 


工 的 考勤 记录 。 所 以 在 执行 完 记 旷工 过 程 后 没有 必要 再 继续 检查 下 去 ， 而 是 直接 终 


记 旷 了 


[过 程 的 代码 如 下 : 


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 
Dim i As Integer, intRow As Integer 

' 取 得 考勤 表 使 用 区 域 行 数 

intRow = Sheets(" 考 勤 表 ").UsedRange.Rows.Count -1 

' 计 算 当 前 日 期 对 应 的 表格 列 号 

j= Day(Now) + 2 


Fori= 


5 To intRow 


If Sheets(" 考 勤 表 ").Cells(i, j)) = " Then 


i= MsgBox(" 所 有 未 签到 员工 是 否 记 未 旷工 ?", vbOKCancel + vbQuestion, "提示 ") 
Ifi= vbYes Then 
记 旷 工 
End If 
EndTimer 
Exit Sub 


End If 


Next 


EndTimer 
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End Sub 


Sub 记 旷 工 () 
Dim intRow As Integer, i As Integer, j As Integer 
intRow = Sheets(" 考 勤 表 ").UsedRange.Rows.Count -1 
j= Day(Now) + 2 
Fori= 5 To intRow 
With Sheets(" 考 勤 表 ") 
If .Cells(i, j)) = "" Then 
.Cells(i, j) = "加 " 
End If 
End With 
Next 
End Sub 


QueryClose 事件 过 程 代码 说 明 : 

口 考勤 签到 窗口 关闭 时 ， 需 要 检查 是 否 有 员工 没有 签到 。 当 有 未 签到 员工 时 ， 提 示 是 
否 将 这 些 没有 签到 员工 的 当天 考勤 记 为 旷工 。 

口 局 部 变量 j 是 当天 的 日 期 在 考勤 表 中 的 列 号 ， 当 天 所 有 员工 的 考勤 记录 都 记录 在 该 

列 下 。 

口 “ 局 部 变量 i 是 当前 考察 的 员工 记录 所 在 的 行 号 。 头 条 员工 记录 位 于 考勤 表 的 第 5 行 ， 
所 以 初始 值 为 5。 因 为 考勤 表 中 最 底部 的 一 行 是 保存 的 行 格式 , 没有 实际 记录 值 ， 所 
以 i 的 结束 值 为 考勤 表 已 使 使 用 区 域 的 行 数 减 1。 

记 有 旷工 过 程 代码 说 明 : 

过 程 首 先 获得 考勤 表 的 最 后 一 行 有 数据 区 域 的 行 数 , 然后 根据 日 期 确定 当日 考勤 记录 的 列 


位 置 ， 最 后 循环 判断 各 个 员工 是 否 已 经 签到 ， 对 于 没有 任何 签到 记录 的 员工 标记 为 旷工 记号 。 


8.4.7 ”设计 窗 体 其 他 功能 代码 


该 模块 所 有 的 重要 功能 都 已 经 实现 ， 但 是 还 有 一 部 分 代码 也 要 实现 的 。 这 部 分 代码 语句 


简单 ， 没 有 包含 在 大 的 功能 中 ， 包 括 窗 体 关 闭 事件 、 员 工 名 的 改变 事件 以 及 窗 体 显 示 过 程 。 


体 。 


窗 体 关闭 事件 过 程 完成 两 个 任务 : 一 是 将 活动 表 重 新 定位 到 主页 表 上 ， 另 一 个 是 卸载 窗 
该 事件 的 代码 如 下 : 

Private Sub btn 关闭 _Click() 

Sheets(" 主 页 ").Select 


Unload Me 
End Sub 


员工 名 改变 事件 用 来 同步 员工 号 标签 控件 的 显示 。 它 根据 用 户 选 择 的 员工 名 所 在 的 索引 


位 置 获取 对 应 的 员工 号 。 该 过 程 代码 如 下 : 


Private Sub comb 员工 名 _Change() 
Lab 员工 号 .Caption = Sheets(" 库 ").Range("A" & comb 员工 名 .Listindex + 2) 
End Sub 


mA 
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考勤 签到 过 程 连接 主页 表 上 的 【考勤 签到 】 按 钮 。 该 过 程 用 于 打开 考勤 签到 窗 体 。 该 过 
程 的 代码 如 下 : 
Sub 考勤 签到 () 
frm 考勤 .Show 
End Sub 
该 过 程 要 连接 到 主页 表 上 的 【考勤 签到 】 按 钮 ， 其 步骤 如 下 : 
(1) 激活 主页 表 ， 右 击 【 考 勤 签到 】 按 钮 。 
(2) 在 弹出 的 快捷 菜单 中 选择 【指定 宏 】 命 令 。 
(3) 打开 【指定 宏 】 对 话 框 ， 在 【 宏 名 】 的 下 拉 列 表 框 中 选择 【考勤 签到 】 宏 ， 单 击 
【确定 】 按 钮 即 可 ， 如 图 8-30 所 示 。 


| 清 如 各 
位 置 风 | 所 有 打开 的 工作 竹 了 
一 


| 
图 8-30 为 【考勤 签到 】 按 钮 指定 宏 


8.5 请 假 登 记 模 块 代码 设计 


在 考勤 签到 模块 中 只 能 记录 员工 正常 出 勤 、 迟 到 和 旷工 3 
种 考勤 情况 。 当 员工 需要 请 假 时 ， 考 勤 签到 模块 将 无 法 完成 。 
请 假 登 记 模块 就 是 用 来 完成 该 功能 的 ， 它 由 一 个 请 假 登 记 窗 体 
来 实现 。 该 窗 体 的 界面 如 图 8-31 所 示 。 

该 窗 体 将 完成 两 部 分 的 任务 : 一 是 将 员工 从 起 始 日 到 结束 
日 的 考勤 记 为 相应 的 请 假 类 型 ， 二 是 将 这 些 信息 登记 到 请 假 登 
记 表 中 。 


图 8-31 请 假 登记 窗 体 界面 
8.5.1 ”请 假 登记 窗 体 设 计 


窗 体 上 存在 的 控件 在 前 面 设计 考勤 登记 窗 体 时 都 有 讲述 ， 这 里 对 于 窗 体 中 如 何 添 加 控件 
的 步骤 不 再 加 以 说 明 。 窗 体 上 的 控件 数量 比较 多 ， 表 8-2 详细 列 出 了 各 个 将 在 代码 中 使 用 到 的 
控件 。 
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表 8-2 ”请假 登记 窗 体 控件 列表 


控件 名 称 | 控件 类 型 说 有明 
frm 请 假 登记 。 | 窗 体 即 请 假 登记 窗 体 ， 在 该 窗 体 完成 请 假 登记 工作 
lab 员工 号 标签 控件 ”| 该 控件 类 似 于 考勤 登记 中 的 员工 号 控件 ， 用 于 校正 员工 名 的 选择 
comb 员工 名 ”| 复合 框 控件 | 该 控件 链接 自 库 表 ， 显 示 了 所 有 员工 的 姓名 。 该 列表 允许 出 现 重复 名 称 
comb 请 假 类 型 | 复合 框 控件 | 该 控件 用 于 获取 员工 请 假 的 类 型 
re 该 控件 用 于 获取 请 假 起 始 日 的 起 始 年 份 。 该 列表 只 包含 两 个 年 份 ， 一 个 
comb 起 始 年 | 复合 杠 控 件 | 后 w 前 的 年 份 ， 一 个 是 当前 年 的 后 年 年 份 。 因 为 请 候 不 可 能 超过 -年 
comb 起 始 月 ”| 复合 杠 控 件 | 该 控件 用 于 获取 请 候 起 始 日 的 起 始 月 份 。 该 列表 的 内 容 从 1 到 12 
”| 该 控件 用 于 获取 请 假 起 始 日 的 起 始 日 期 。 列 表 将 根据 当前 月 份 确定 到 底 
comb 起 始 日 。 | 复合 框 控件 | 该 月 有 多 少 天 ， 然 后 再 生成 列表 内 容 
comb 结束 年 。 | 复合 框 控件 | 用 于 获取 请 假 结束 日 的 结束 年 份 。 同 comb 起 始 年 控件 类 似 
comb 结束 月 ”| 复合 框 控件 | 用 于 获取 请 假 结束 日 的 结束 月 份 。 同 comb 起 始 月 控件 类 似 
comb 结束 日 | 复合 框 控件 | 用 于 获取 请 假 结束 日 的 结束 日 期 。 同 comb 起 始 日 控件 类 似 
btn 确定 按钮 控件 。 | 选择 该 按钮 将 根据 窗 体 输入 数据 完成 员工 请 假 登记 工作 
btn 取消 按钮 控件 ”| 退出 窗 体 


上 述 请 假 类 型 复合 框 控件 包含 了 病假 、 事 假 与 出 差 3 种 情况 。 起 始 日 和 结束 日 都 是 通过 3 
个 符合 框 控件 来 获取 的 。 起 始 日 和 结束 日 用 当前 日 完成 初始 化 。 


8.5.2 ” 窗 体 初始 化 


整个 窗 体 的 大 部 分 工作 都 在 【确定 】 按 钮 单 击 事件 中 完成 。 有 少 部 分 事件 ， 例 如 员工 名 
复合 框 改变 事件 、 月 复合 框 改 变 事 件 等 ， 它 们 都 是 为 了 完成 相应 辅助 输入 员工 请 假 信息 而 设 
置 的 。 而 在 整个 窗 体 正常 运作 之 前 ， 窗 体 完 成 了 对 自己 的 初始 化 工作 。 初 始 化 完成 的 工作 主 
要 是 为 各 个 复合 框 控件 获取 对 应 的 列表 数据 。 

以 下 代码 是 该 窗 体 的 初始 化 代码 : 

Private Sub UserForm_lnitialize() 

Dim intRow As Integer 


获取 请 假 类 型 列表 框 数 据 
With comb 请 假 类 型 


.Clear 


.Addltem "事假 " 
.Addltem "病假 " 
.Addltem "出 差 " 


End With 


获取 员工 名 列表 框 数据 
intRow = Sheets(" 库 ").UsedRange.Rows.Count 
comb 员工 名 .RowSource = " 库 !B2:B" & intRow 
获取 年 月 日 各 列表 框 数据 


初始 化 年 月 日 


End Sub 


= 
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代码 说 明 : 

口 程序 首先 为 请 假 类 型 列表 复合 框 获取 列表 数据 。 在 该 步骤 中 ， 首 先 清除 该 复合 框 数 
据 ， 以 免 造 成 潜在 的 列表 数据 内 容重 复 问题 。 

口 然后 程序 获取 了 库 表 的 可 用 数据 行 数 ， 根 据 该 行 数 确定 了 所 有 员工 的 员工 名 在 库 表 

中 的 范围 。 使 用 复合 框 的 RowSource 属性 直接 获取 员工 列表 数据 。 

口 年 月 日 列表 框 的 初始 化 稍微 复杂 ， 初 始 化 过 程 调用 了 自 定义 过 程 完成 该 工作 。 相 关 
年 月 日 复合 框 的 设计 内 容 参见 8.5.3 节 。 


8.5.3 年 月 日 复合 框 相 关 代 码 设计 


之 被 侧 扣 (6 入 外 s 用 关 在 四 将 了 了 济 应 的 年份 和 为 从 
后 , 该 月 份 下 的 日 复合 框 内 的 日 期 数据 需要 随 新 年 份 
下 面 的 初始 化 年 月 日 过 程 用 于 设置 窗口 中 所 有 
与 年 月 日 相关 的 复合 框 控件 的 项 目 。 在 该 过 程 中 需要 
年 份 和 次 年 年 份 即 可 ， 月 复合 框 的 项 目 是 固定 的 
1~12。 如 图 8-32 所 示 的 是 该 过 程 的 详细 流程 图 。 
Dim nowYear As String, nowMonth As String, nowDate As String 
Dim i As Integer 
nowMonth = Format(Now, "M") 
nowDate = Format(Now, "D") 
.Clear 
.Addltem nowYear 
End With 
' 初 始 化 结束 年 列表 框 数据 
.Addltem nowYear 
.Addltem CStr(CInt(nowYear) + 1) 


在 窗口 中 包含 了 很 多 与 年 月 日 相关 的 设置 控件 , 窗口 初始 化 时 ,这些 控 件 的 内 容 页 需要 随 
和 月 份 发 生变 化 ,要 完成 这 些 工作 都 需要 本 节 介绍 的 
过 程 执 行 相应 的 任务 。 4 
设置 4 个 复合 框 的 项 目 ， 这 些 复合 框 分 别 是 起 始 年 、 
结束 年 、 起 始 月 和 结束 月 。 两 个 年 复合 框 只 需要 当前 
下 面 的 程序 代码 是 年 月 日 初始 化 自 定义 过 程 : 同 8-32， 科 六 化 生 豚 日 复合 柜 流 程 图 
Sub 初始 化 年 月 日 () 
获取 当前 年 月 日 数据 
nowYear = Format(Now, "YYYY") 
' 初 始 化 起 始 年 列表 框 数据 
With comb 起 始 年 
.Addltem CStr(CInt(nowYear) + 1) 
.Value = nowYear 
With comb 结束 年 
.Clear 
.Value = nowYear 
End With 


pe 


变更 


起 始 日 或 结束 日 所 在 月 份 的 总 天 数 ， 然 后 通过 一 个 
For 循环 将 该 月 份 各 个 日 期 添加 到 列表 框 中 。 在 计算 


某 月 总 天 数 时 是 通过 计算 当月 1 号 与 次 月 的 1 号 之 
间 的 差 确定 的 。 当 起 始 日 或 结束 日 为 12 月 某 日 时 ， 
此 时 的 次 月 是 次 年 的 1 月 份 ， 而 其 他 情况 下 次 月 都 
是 起 始 月 或 结束 月 加 1 即 可 。 两 个 过 程 的 流程 大 体 


5 办 公 应 用 非 啼 之 禾 


Excel VBA 应 用 开发 经 典 案例 


"初始 化 起 始 月 列表 框 数据 
With comb 起 始 月 


.Clear 

Fori= 1 To 12 
.Addltem CStr(i) 

Next 

.Value = nowMonth 


End With 
' 初 始 化 结束 月 列表 框 数据 
With comb 结束 月 


.Clear 

Fori=1To12 
.Addltem CStr(i) 

Next 

.Value = nowMonth 


End With 

' 初 始 化 起 始 日 与 结束 日 列表 框 数据 
刷新 起 始 日 

刷新 结束 日 

comb 起 始 日 .Value = nowDate 
comb 结束 日 .Value = nowDate 


End Sub 

代码 说 明 : 

口 在 过 程 的 前 面部 分 ， 程序 获取 了 当前 日 期 的 年 月 日 数据 ， 这 部 分 数据 将 被 初始 化 过 
程 作为 初始 数据 。 即 当 完 成 初始 化 工作 后 ， 在 年 月 日 中 显示 的 年 月 日 即 为 当前 日 期 。 

口 初始 化 年 列表 框 时 ， 首 先 清除 了 列表 框 的 内 容 ， 然 后 向 该 列表 框 中 写 入 了 两 个 年 份 ， 
分 别 是 当前 年 份 以 及 次 年 的 年 份 。 因 为 记 请 假 时 年 份 的 跨度 不 可 能 超过 两 个 年 份 。 

口 ”初始 化 月 列表 框 比 较 简 单 。 通 过 一 个 循环 将 1~12 的 整数 写 入 即 可 。 因 为 每 一 年 都 包 
含 子 设 个 月 。 

口 ”初始 化 日 列表 框 使 用 了 自 定义 过 程 。 因 为 否 


当 窗 体 初 始 化 或 者 年 份 与 月 份 列表 框 数据 发 生 
时 将 会 触发 刷新 起 始 日 和 结束 日 列表 框 过 程 。 
在 刷新 起 始 日 和 刷新 结束 日 过 程 中 ， 首 先 需 要 计算 


起 始 月 是 12 月 ? 
获取 起 始 月 1 号 与 次 年 1 月 1 号 日 期 差 DateCount 
获取 起 始 月 1 号 与 次 月 1 号 日 期 差 DateCount 


刷新 日 列表 框 过 程 中 的 代码 可 以 在 年 份 和 
月 份 的 变更 事件 中 重复 使 用 。 刷 新 日 列表 
框 的 相关 代码 见 下 面 的 介绍 。 


类 似 ， 如 图 8-33 所 示 的 是 刷新 起 始 日 过 程 的 流程 。 图 8-33 刷新 起 始 日 流程 图 
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以 下 是 这 两 个 过 程 的 详细 代码 解释 : 
Sub 刷新 起 始 日 () 
Dim DateCount As Integer, i As Integer 
' 根 据 不 同情 况 计 算 当 前 起 始 年 与 起 始 月 下 的 日 期 数 
lf Clnt(comb 起 始 月 ) = 12 Then 
DateCount = DateDiff("d", comb 起 始 年 & "-" & comb 起 始 月 & "-1", CStr(CInt(comb 起 始 年 ) + 1) 
&"-1-1") 
Else 
DateCount = DateDiff("d"，comb 起 始 年 & "-" & comb 起 始 月 & "-1"，comb 起 始 年 & "-" & 
CStr(CInt(comb 起 始 月 ) + 1) & "-1") 
End If 
' 刷 新 日 列表 框 数据 
comb 起 始 日 .Clear 
Fori= 1 To DateCount 
comb 起 始 日 .Addltem i 
Next 
End Sub 


Sub 刷新 结束 日 () 
Dim DateCount As Integer, i As Integer 
"根据 不 同情 况 计 算 当 前 结束 年 与 结束 月 下 的 日 期 数 
lf CInt(comb 结束 月 ) = 12 Then 
DateCount = DateDiff("d", comb 结束 年 & "-" & comb 结束 月 & "-1", CStr(CInt(comb 结束 年 ) + 1) 
B11) 
Else 
DateCount = DateDiff("d"，comb 结束 年 & "-" & comb 结束 月 & "-1"，comb 结束 年 & "-" & 
CStr(CInt(comb 结束 月 ) + 1) & "-1") 
End If 
' 刷 新 结束 日 列表 框 数据 
comb 结束 日 .Clear 
Fori= 1 To DateCount 
comb 结束 日 .Addltem i 


Next 

代码 说 明 : 

口 起 始 日 与 结束 日 列表 框 数据 确定 的 方法 都 是 一 样 的 ， 因 此 两 个 自 定义 过 程 的 代码 基 
本 上 是 一 致 的 。 


口 要 确定 日 列表 框 的 数据 ， 唯 一 需要 确定 的 就 是 当前 选择 的 年 月 下 该 月 的 日 数 。 这 里 
确定 的 方法 是 通过 当前 月 份 的 1 号 日 期 与 次 月 的 1 号 对 比 获 得 (关于 DateDiff 函数 
的 介绍 见 8.1.6 节 ) ， 但 是 当当 前 选择 月 份 为 12 月 份 时 ， 计 算 次 月 的 方式 发 生 很 大 
变化 ， 因 为 次 月 是 次 年 的 1 月份 ， 所 以 这 里 使 用 了 If 语句 。 
口 ”在 获得 对 应 的 日 期 数 后 ， 日 列表 框 的 数据 就 很 容易 被 确定 下 来 。 这 里 通过 一 个 循环 
将 从 1 到 该 日 期 数 的 所 有 整数 写 入 了 该 日 列表 框 。 
前 面 讲 到 在 月 份 列表 框 数据 发 生变 更 时 将 会 触发 刷新 起 始 日 和 结束 日 列表 框 过程 。 这 些 
过 程 的 代码 都 很 简单 ， 仅 仅 触发 相应 日 列表 框 的 刷新 自 定义 过 程 ， 这 里 不 再 列 出 详细 的 程序 
说 明 。 这 些 事件 的 过 程 代 码 如 下 : 


5 办 公 应 用 匡 峰之 能 
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Private Sub comb 结束 年 _Change() 
刷新 结束 日 
End Sub 


Private Sub comb 结束 月 _Change() 
刷新 结束 日 
End Sub 


Private Sub comb 起 始 年 _ Change() 
刷新 起 始 日 
End Sub 


Private Sub comb 起 始 月 _Change() 
刷新 起 始 日 
End Sub 


8.5.4 确认 请 假 登 记 代 码 设计 
在 确认 请 假 登记 过 程 中 需要 完成 的 工作 比较 多 ， 包 括 检查 列表 框 控件 内 容 是 否 空 、 检 查 


日 期 差 是 否 超额 、 检 查 起 始 日 是 否 位 于 结束 日 后 等 众多 步骤 。 这 些 步 骤 中 大 部 分 都 是 并 不 复 
杂 的 判断 ， 只 有 判定 员工 跨 月 请 假 时 需要 多 进行 些 处 理 。 如 图 8-34 所 示 的 是 该 过 程 的 流程 图 。 


图 8-34 ”确认 请 假 登 记 流程 图 


Private Sub btn 确定 _Click() 
Dim i As Integer, j As Integer, DateCount As Integer 


Dim intRow As Integer, rg As Range 

' 检 查 各 个 列表 框 控件 数据 是 否 为 空 

If comb 员工 名 .Value = " Then 
MsgBox "没有 选择 员工 名 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

lf comb 请 假 类 型 .Value = "" Then 
MsgBox "没有 选择 请 假 类 型 ! " vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End 上 f 

If comb 起 始 年 .Value = "" Then 
MsgBox "没有 选择 起 始 年 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End if 

If comb 起 始 月 .Value = " Then 
MsgBox "没有 选择 起 始 月 !", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

lf comb 起 始 日 .Value = " Then 
MsgBox "没有 选择 起 始 日 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

ff comb 结束 年 .Value = "" Then 
MsgBox "没有 选择 结束 年 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

If comb 结束 月 .Value = "" Then 
MsgBox "没有 选择 结束 月 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

If comb 结束 日 .Value = "" Then 
MsgBox "没有 选择 结束 日 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

' 计 算 起 始 日 与 结束 日 间 的 日 期 差 

DateCount = DateDiff("d", comb 起 始 年 & "-" & comb 起 始 月 & "-" & comb 起 始 日 , comb 结束 年 & "-" 

& comb 结束 月 & "-" & comb 结束 日 ) 

' 当 日 期 差 是 否 超过 31 天 

IfDateCount > 31 Then 
MsgBox "起 始 日 与 结束 日 间 不 能 超过 31 天 ! ", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

' 检 查 结束 日 是 否 在 在 起 始 日 前 

If DateCount < 0 Then 
MsgBox "结束 日 不 能 在 起 始 日 前 !", vbOKOnly + vblnformation, "提示 " 
Exit Sub 

End If 

' 根 据 员 工 号 在 考勤 表 中 找到 该 员工 

Set rg = Sheets(" 考 勤 表 ").Range("A5").EntireColumn.Find(Lab 员工 号 .Caption) 

Ifrg ls Nothing Then 
MsgBox "该 员工 在 考勤 表 中 不 存在 ! ", vbOKOnly + vblnformation, "提示 " 


办 公 应 用 匡 党 之 荡 
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Exit Sub 
Else 
intRow = rg.Row 
End If 
' 检 查 是 否 存在 跨 月 请 假 情况 
lf Clnt(comb 起 始 月 ) <> CInt(comb 结束 月 ) Then 
DateCount = DateDiff("d"，comb 起 始 年 & "-" & comb 起 始 月 & "-1"，comb 起 始 年 & "-" & 
CStr(CInt(comb 起 始 月 ) + 1)&"-1") 
Fori = CInt(comb 起 始 日 ) To DateCount 
Select Case comb 请 假 类 型 
Case "事假 " 
Sheets(" 考 勤 表 ").Cells(intRow,i+ 2) = "全 " 
Sheets(" 考 勤 表 ").Cells(intRow, 40) = "全 " 
Case "病假 " 
Sheets(" 考 勤 表 ").Cells(intRow,i+ 2)="A" 
Sheets(" 考 勤 表 ").Cells(intRow, 40) = "A" 
Case "出 差 " 
Sheets(" 考 勤 表 ").Cells(intRow, i+ 2) = "C" 
Sheets(" 考 勤 表 ").Cells(intRow, 40) = "C" 
End Select 
js 
Next 
DateCount = DateDiff("d", comb 起 始 年 &"-" & comb 起 始 月 & "-" & comb 起 始 日 , comb 结束 年 & 
"-"& comb 结束 月 & "-" & comb 结束 日 ) 
Sheets(" 考 勤 表 ").Cells(intRow, 41) = DateCount j+ 1 
Else 
For i= Clnt(comb 起 始 日 ) To CInt(comb 结束 日 ) 
Select Case comb 请 假 类 型 
Case "事假 " 
Sheets(" 考 勤 表 ").Cells(intRow,i+ 2) = "A" 
Case "病假 " 
Sheets(" 考 勤 表 ").Cells(intRow,i+ 2) = "A" 
Case "出 差 " 
Sheets(" 考 勤 表 ").Cells(intRow, i + 2) = "C" 
End Select 
Next 
End If 
' 在 请 假 登记 表 中 记录 该 员工 的 请 假 记录 
With Sheets(" 请 假 登记 表 ") 
intRow = .UsedRange.Rows.Count 
.Cells(intRow, 1).EntireRow.Insert 
.Cells(intRow, 1) = Lab 员工 号 .Caption 
.Cells(intRow, 2) = comb 员工 名 .Value 
.Cells(intRow, 3) = comb 请 假 类 型 .Value 
.Cells(intRow, 4) = comb 起 始 年 & "-" & comb 起 始 月 & "-" & comb 起 始 日 
.Cells(intRow, 5) = comb 结束 年 & "-" & comb 结束 月 & "-" & comb 结束 日 
End With 
End Sub 


代码 说 明 : 
口 “程序 首先 检测 各 个 列表 框 控件 内 容 是 否 为 空 ， 以 确保 后 面 的 代码 以 及 相关 的 操作 能 


_ 
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获取 到 数据 。 
口 “在 该 程序 中 ， 默 认 的 请 假 天 数 不 能 超过 31 天 ， 在 程序 中 需要 检测 日 期 差 是 否 超过 这 
个 额度 。 


口 ” 对 于 起 始 日 和 结束 日 有 先后 顺序 ， 这 个 先后 顺序 是 由 DateCount 的 正 负 情况 确定 的 。 

口 ”考勤 表 是 逐 月 记录 的 。 当 出 现 跨 月 请 假 情况 时 ， 需 要 将 请 假 的 类 型 以 及 剩余 天 数 记录 
在 请 假 统计 的 请 假 类 型 和 假期 剩余 里 。 这 些 数据 将 在 下 一 个 月 产生 新 的 考勤 表 时 被 调 
用 并 清除 。 当 请 假 的 起 始 与 结束 年 月 一 致 时 ， 只 需要 将 请 假 类 型 登记 到 当前 月 即 可 。 

口 “ 当 完 成 了 考勤 表 的 登记 后 ， 还 需要 将 该 员工 的 请 假 记录 登记 到 请 假 登 记 表 中 。 该 表 
记录 了 员工 请 假 的 流水 账 。 


8.6 系统 测试 


本 系统 包含 3 个 部 分 ， 本 节 测 试 部 分 将 对 系统 的 3 个 功能 部 分 分 别 加 以 测试 ， 具 体 包括 
员工 资料 登记 、 员 工 考勤 登记 和 员工 请 假 登记 。 这 里 3 个 测试 都 针对 同一 个 员工 。 


8.6.1 员工 资料 登记 


(1) 在 主页 单 击 【 员 工资 料 管理 】 按 钮 ， 系 统 自动 激活 员工 档案 卡 工作 表 。 此 时 该 工作 
表 中 显示 的 是 最 后 一 位 员工 的 信息 。 此 处 需要 建立 新 员工 的 信息 ， 用 户 只 需要 在 加 载 项 菜单 
中 单 击 【 增 加 】 按 钮 即 可 。 在 员工 档案 卡 表 中 建立 新 员工 信息 如 图 8-35 所 示 。 


图 8-35 新 员工 资料 建立 


(2) 建立 好 该 员工 的 信息 资料 后 ， 在 加 载 项 菜单 中 单 击 【保存 】 按 钮 。 此 时 新 员工 的 资 
料 信息 将 被 保存 到 库 中 。 打 开 库 表 可 以 查看 到 该 条 刚 建立 的 员工 信息 ， 如 图 8-36 所 示 。 
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图 8-36 库 表 员 工 信 息 


8.6.2 ”员工 考勤 登记 


在 主页 单 击 【 考 勤 签到 】 按 钮 ， 在 随后 打开 的 【考勤 签到 】 对 话 框 中 选择 员工 名 周 益 正 ， 
如 图 8-37 所 示 。 单 击 【签到 】 按钮， 由 于 已 经 超过 了 时 间 ， 系 统 认 定 该 员工 为 迟到 ， 如 图 8-38 
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图 8-37 【考勤 签到 】 对 话 杠 


a ls lelplslelelnlsiilririnisiolele zlulvislzirlzlamilaclap ill 


ls 
考勤 表 


2 4 村 加 病根 人 入 工 罩 过 到 去 


于 于 于 于 于 于 于 于 于 于 和 


Fa 台 9 FEFrarnene 


全 捷 时 和 村 站 二 提 3 站 尾 挤 
生生 二 
I 直 贡 和 业 上 请 也 交 才 机 析 ] 考区. 话 天 CI 
图 8-38 考勤 签到 结果 


8.6.3 ”员工 请 假 登 记 


在 主页 单 击 【请 假 登记 】 按 钮 ， 在 随后 弹出 的 【请 假 登记 】 
对 话 框 中 设置 员工 名 、 请 假 类 型 和 时 间 器 度 ， 如 图 8-39 所 示 。 
最 终 在 考勤 表 中 该 员工 当日 的 出 勤 信息 被 以 实心 三 角 板 标记 ， 
如 图 8-40 所 示 。 员工 的 所 有 请 假 信息 页 将 被 登记 到 请 假 登记 表 
中 ， 该 表 的 结果 如 图 8-41 所 示 。 
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图 8-41 请 假 登 记 表 


第 9 章 商场 销售 数据 管理 系统 


对 于 大 部 分 企业 ， 商 品 销售 管理 可 以 使 用 比较 大 众 化 的 软件 ， 但 很 多 时 候 企 业 的 商品 都 
具有 自己 的 特殊 性 ， 用 户 希望 能 够 定制 适合 自己 的 管理 软件 。 本 系统 即 为 一 个 实例 ， 它 被 开 
发 用 于 针对 连锁 商场 电器 商品 销售 数据 记录 与 统计 的 管理 。 该 系统 的 个 性 很 强 ， 对 于 希望 开 
发 自己 的 管理 系统 的 用 户 是 一 个 借鉴 。 


9.1 系统 概论 


系统 所 针对 的 对 象 仅仅 是 连锁 商场 的 电器 商品 。 系 统 功 能 包括 基本 数据 建立 、 商 品 销售 
登记 、 商 品 销售 查询 与 统计 。 本 系统 是 一 个 数据 与 程序 完全 分 离 的 系统 ， 所 有 的 数据 资料 都 
通过 单独 的 文件 保存 ， 并 且 基 本 数据 和 商品 销售 数据 也 是 单独 存放 。 


设计 思路 


本 系统 以 Excel 为 操作 平台 ， 使 用 Access 文件 保存 数据 ， 通 过 DAO 对 象 模型 实现 Excel 
程序 文件 与 Access 数据 文件 间 的 数据 互动 。 值 得 一 说 的 是 ， 在 本 书 中 共有 3 个 例子 讲述 了 这 
种 前 台 程序 文件 与 后 台数 据 文件 的 互动 。 在 前 面 的 客户 管理 系统 中 , 采用 了 Excel 数据 保存 与 
Access 文件 保存 相 结 合 的 方式 ,在 这 个 章节 读者 可 以 初步 了 解 DAO 对 象 的 使 用 。 本 章 实例 则 
完全 使 用 DAO 对 象 模型 ， 这 里 读者 可 以 完全 了 解 该 对 象 的 使 用 ,后面 的 合同 管理 系统 将 使 用 
DAO 对 象 模型 实现 相同 功能 。 

本 系统 的 功能 包括 基本 数据 建立 、 商 品 销售 数据 登记 、 商 
品 销售 数据 查询 与 分 析 3 大 功能 。 用 户 在 操作 时 完全 通过 窗 体 
实现 交互 。 该 系统 的 功能 结构 如 图 9-1 所 示 。 

以 下 是 系统 中 用 到 的 所 有 窗 体 的 大 致 介绍 。 

口 、 基 本 信息 设置 窗 体 : 窗 体 名 称 为 fmSetup, 在 该 窗 体 
中 可 以 浏览 与 编辑 已 经 建立 的 基本 资料 。 这 些 资料 

包括 商场 名 、 商 品 品牌 与 规格 信息 。 

口 “商品 销售 数据 登记 窗 体 : 窗 体 名 称 为 fmInput， 在 该 
窗 体 中 可 以 输入 商品 销售 数据 ， 包 括 商 场 名 、 品 牌 图 9-1 商场 销售 数据 管理 系统 
名 称 、 商 品 规格 、 尺 寸 、 销 售 数量 、 销 售 单价 。 该 功能 结构 图 
窗 体 是 一 个 多 用 途 窗 体 ， 它 不 仅 可 以 在 销售 商品 时 使 用 ， 也 可 以 在 查询 数据 时 修改 
数据 。 
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口 “查询 销售 数据 设置 窗 体 : 窗 体 名 称 为 fmQuery， 在 该 窗 体 中 可 以 设置 各 种 详细 的 查 
询 选 项 。 在 商品 销售 数据 登记 窗 体 中 包含 的 项 目 都 出 现在 了 这 些 查 询 选项 中 。 当 该 
窗 体 中 没有 设置 任何 项 目的 查询 条 件 时 ， 默 认 的 查询 方式 即 为 查询 所 有 销售 数据 。 

口 “查询 条 件 编辑 窗 体 ; 窗 体 名 称 为 fmFilterEdit， 在 该 窗 体 中 可 以 重新 编辑 查询 条 件 。 
该 窗 体 不 仅 可 以 编辑 最 终 查 询 条 件 ， 还 可 以 单独 编辑 某 一 项 的 查询 条 件 。 

口 ”查询 显示 窗 体 : 窗 体 名 称 为 fmQryResult， 在 该 窗 体 中 显示 了 满足 查询 条 件 的 所 有 销 
售 记录 。 用 户 可 以 修改 这 些 数据 也 可 以 导出 数据 。 


9.2 ”数据 表 设 计 


在 该 系统 中 数据 与 前 台 程序 代码 是 分 开 存 放 的 。 另 外 ， 不 同 的 数据 也 是 分 开 保存 的 。 基 
本 资料 数据 和 商场 销售 数据 资料 分 开 保存 在 两 个 数据 文件 中 ， 这 些 文件 都 是 Access 文件 。 为 
便于 后 面前 台 窗 体 与 程序 设计 部 分 的 讲述 ， 本 章 首 先 介绍 数据 表 的 建立 。 

值得 注意 的 是 这 些 数据 文件 都 保存 在 DB 文件 夹 中 ,该 文件 夹 应 该 与 Excel 文件 位 于 同一 
文件 夹 中 。 基 本 信息 资料 表 的 名 称 是 Info.mdb， 商 品 销售 数据 资料 表 的 名 称 为 DB.mdb。 


9.2.1 基本 信息 资料 表 设 计 


在 基本 信息 资料 表 文 件 中 有 3 个 表 ， 分 别 是 t_MarketInfo、 三 
t_ MarkInfo 和 t ProductInfo。 使 用 Access 2007 打开 该 文件 后 ， es 
可 以 在 表 列表 框 中 看 到 如 图 9-2 所 示 的 情况 。 
下 面 是 各 个 表 的 详细 介绍 。 图 9-2 基本 信息 资料 表 中 的 表 


口 表 t_MarketInfo: 存储 商场 名 信息 。 仅 有 一 个 字段 即 商场 名 称 ， 字 段 的 数据 类 型 为 文 
本 。 图 9-3 与 图 9-4 分 别 显 示 了 该 表 的 设计 视图 与 数据 表 视 图 格式 。 
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9-3” 表 t_MarketInfo 设计 视图 图 9-4 表 t_MarketInfo 数据 表 视 图 


口 表 t_MarkInfo: 该 表 中 存储 的 是 品牌 名 称 。 仅 包含 一 个 字段 即 品牌 名 称 , 字段 的 数据 
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类 型 为 文本 。 图 9-5 与 图 9-6 分 别 是 该 表 的 设计 视图 与 数据 表 视 图 格式 。 该 表 与 表 
t_ProductInfo 建立 了 对 应 关系 ， 因 而 其 数据 表 视 图 与 表 t_ MarketInfo 的 数据 表 视 图 存 
在 差别 。 要 查看 该 关系 ， 可 以 首先 进入 设计 模式 然后 在 设计 模式 标题 上 右 击 ， 在 弹 
出 的 快捷 菜单 中 选择 【关系 】 命 令 即 可 。 图 9-7 与 图 9-8 分 别 显示 了 打开 关系 窗口 的 


方式 与 关系 窗口 的 界面 。 
加 Uarkarfo x 
投 名 黎 | 数据 类 型 说 明 已 
文本 国 国 tMarknfo -ox 
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图 9-6 表 t_MarkInfo 数据 表 视 图 


3 关系 


tMarkinfo 
Y MarkNan| 


4 国 


图 9-7 在 设计 视图 中 打开 关系 窗口 图 9-8 表 关 系 窗口 
口 t ProductInfo: 该 表 存储 的 是 商品 的 相关 信息 。 包 含 的 3 个 字段 分 别 是 品牌 名 称 〈 文 
本 类 型 ) 、 商 品名 称 〈 文 本 类 型 ) 和 商品 规格 〈 文 本 类 型 ) 。 图 9-9 与 图 9-10 分 别 
显示 了 该 表 的 设计 视图 与 数据 表 视 图 格式 。 
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9.2.2 ”商品 销售 数据 资料 表 设计 


商品 销售 数据 资料 表 用 于 存储 明细 的 商品 销售 数据 ， 该 资料 表 仅 包含 了 一 个 表 即 t_Sale。 
图 9-11 与 图 9-12 分 别 显 示 了 该 表 的 设计 视图 与 数据 表 视 图 格式 。 表 t_Sale 的 结构 建立 方式 在 
系统 中 不 是 通过 手动 建立 的 。 在 系统 中 有 段 代 码 负责 建立 该 表 的 结构 ， 读 者 可 以 参考 该 段 代 
码 学 习 如 何 通过 DAO 对 象 在 Access 表 中 建立 新 表 的 方式 。 该 段 代码 将 在 后 续 章 节 加 以 介绍 。 
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图 9-11 表 t_Sale 设计 视图 
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图 9-12 表 t Sale 数据 表 视 图 


9.3 公共 模块 代码 设计 


在 系统 中 存在 部 分 公共 变量 与 公用 函数 ， 这 些 公共 变量 和 公共 函数 不 能 被 保存 在 窗 体 中 ， 
但 是 它们 又 必须 被 窗 体 调用 。 系 统 的 公共 模块 正 是 为 了 保存 这 些 公共 变量 与 公共 函数 而 设立 
的 。 系 统 建立 了 两 个 公共 模块 ， 分 别 用 来 保存 公共 变量 和 公共 函数 与 过 程 。 
9.3.1 公共 变量 模块 设计 


在 公共 变量 模块 存储 了 系统 中 使 用 到 的 所 有 公共 变量 。 这 些 变 量 将 在 系统 运行 过 程 中 被 
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初始 化 并 反复 调用 。 以 下 是 定义 这 些 公共 变量 的 代码 : 


' 全 局 变量 

Public db As DAO.Database 数据 库 对 象 

Public strMarketFilter As String "存储 对 商场 的 单项 筛选 条 件 
Public strMarkFilter As String "存储 对 品牌 的 单项 筛选 条 件 
Public strProductFilter As String "存储 对 产品 型 号 的 单项 筛选 条 件 
Public strSizeFilter As String "存储 对 尺寸 的 单项 筛选 条 件 
Public strNumberFilter As String "存储 对 数量 的 单项 筛选 条 件 
Public strPriceFilter As String ' 存 储 对 单价 的 单项 筛选 条 件 
Public strDateFilter As String ' 存 储 对 日 期 的 单项 筛选 条 件 
Public intFilterIndex As Integer "决定 操作 是 针对 哪个 单项 的 
Public strSQL As String ' 总 筛选 条 件 

Public opMethod As Boolean ' 运 算 方式 

Public isEditRecord As Boolean 判断 是 否 在 修改 记录 

Public arrEdited As Variant "记录 被 编辑 记录 的 数据 

Public itemEdited As Listltem ' 被 编辑 的 记录 

Public isNeedUpdate As Boolean ' 是 否 需要 更 新 列表 

Public isSaveAll As Boolean ' 表 示 保 存 结果 的 范围 (总 查询 记录 集 或 选择 后 的 记录 集 ) 
代码 说 明 : 


大 部 分 的 变量 从 代码 注释 中 就 可 以 了 解 该 变量 的 意义 ， 例 如 那些 单项 筛选 条 件 ， 这 部 分 
变量 记录 的 正 是 查询 窗口 中 每 一 个 单项 的 查询 条 件 ， 而 总 筛选 条 件 则 是 对 单项 筛选 条 件 的 综 
合 。 还 有 部 分 变量 单 从 注释 中 无 法 详细 了 解 它 们 的 功用 。 这 里 将 对 这 些 变量 加 以 说 明 : 
口 intFilterIndex 整 型 变量 ; 该 变量 记录 的 是 当前 用 户 设置 的 查询 条 件 是 属于 哪个 单项 
的 。 例 如 当 单 击 了 某 个 单项 查询 条 件 的 【修改 】 按 钮 时 ， 这 个 变量 将 会 被 设置 为 该 
项 的 对 应 序号 。 编 辑 查询 条 件 窗 口 根据 该 变量 确定 显示 和 编辑 操作 是 针对 哪个 单 
项 的 。 

口 opMethod 布尔 变量 : 该 变量 被 用 在 查询 条 件 设置 窗口 中 ， 它 记录 了 当前 设置 的 运算 
方式 。 对 于 每 个 单项 ， 可 以 设置 查询 条 件 的 运算 方式 。 例 如 : 当 需 要 查询 两 个 商场 
的 所 有 销售 记录 时 。 在 查询 设置 窗口 中 ， 首 先 选 择 第 一 个 商场 名 ， 并 确认 运算 方式 
是 否 运算 ， 单 击 该 项 对 应 的 【添加 】 按 钮 ， 第 一 个 查询 商场 条 件 即 被 设置 。 然 后 再 
次 选中 第 二 个 商场 ， 单 击 【 添 加 】 按 钮 。 此 时 单 击 【 编 辑 】 按 钮 时 就 会 出 现 类 似 以 
下 内 容 的 条 件 “MarketName=' 大 润 发 春 申 ' or MarketName=' 国 美 二 店 '”。 

口 isNeedUpdate 布尔 变量 : 该 变量 用 于 确认 是 否 重 新 显示 查询 结果 窗 体 中 显示 的 记录 数 
据 。 当 完成 记录 的 编辑 工作 后 ， 并 退出 销售 记录 编辑 窗 体 时 ， 显 示 在 查询 结果 窗 体 
上 的 数据 需要 立即 更 新 。 如 果 在 销售 记录 编辑 窗 中 没有 进行 修改 或 删除 操作 ， 此 时 
没有 必要 更 新 结果 显示 。 

口 isSaveAll 布尔 变量 : 在 查询 结果 窗口 中 ， 可 以 有 针对 性 地 选择 已 查询 到 的 结果 记录 ， 

并 且 将 该 结果 导出 到 新 的 Excel 文件 中 。 该 变量 正 是 用 于 标识 当前 的 数据 导出 是 全 前 
查询 结果 导出 还 是 部 分 结果 导出 。 
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9.3.2 ”启动 窗 体 公共 过 程 代 码 设计 


公共 函数 与 过 程 模块 中 包含 的 过 程 与 函数 比较 多 ， 但 是 可 以 划分 为 几 个 部 分 ， 它 们 是 启 
动 窗 体 过 程 、 总 查询 字符 串 修改 过 程 、 数 据 库 建 立 与 更 新 过 程 、 压 缩 数 据 库 过 程 。 启 动 窗 体 
过 程 被 自 定义 菜单 调用 ， 通 过 自 定义 菜单 可 以 访问 对 应 的 窗 体 。 本 小 节 主要 讲解 启动 窗 体 过 
程 的 代码 设计 ， 随 后 的 小 节 将 依次 讲解 剩 下 的 各 个 过 程 。 以 下 是 该 过 程 的 代码 : 

"启动 窗 体 过 程 

Sub RunlnputForm() "启动 输入 信息 窗 体 


frmlnput.Show 
End Sub 


Sub RunQueryForm() "启动 查询 窗 体 
frmQuery.Show 
End Sub 


Sub CreateBaselnfo() "启动 基本 数据 建立 系统 
frmSetup.Show 
End Sub 
代码 说 明 : 
上 述 启 动 窗 体 的 过 程 包含 的 语句 都 十 分 简单 ， 这 些 过 程 名 在 建立 自 定义 菜单 时 被 使 用 ， 
选择 对 应 的 菜单 即 会 调用 对 应 的 过 程 打开 对 应 的 窗 体 。 


9.3.3 总 查询 字符 串 设置 过 程 
在 查询 设置 窗口 中 ， 当 所 有 的 查询 单项 的 条 件 都 设置 完 后 〈 当 然 也 可 以 不 设置 部 分 单项 ， 


程序 会 自动 加 以 识别 ) ， 程 序 将 通过 该 过 程 产 生 总 查询 字符 串 。 只 有 获得 了 该 字符 串 后 才能 
获得 满足 条 件 的 数据 库 查 询 记 录 集 。 该 自 定义 过 程 的 流程 图 如 图 9-13 所 示 。 


初始 化 总 查询 字符 串 


图 9-13 总 查询 字符 串 设置 过 程 流程 图 
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Sub SetSQL() ' 修 改 总 查询 字符 串 
strSQL = ” "初始 化 总 查询 字符 串 
' 检 查 商场 名 查询 条 件 是 否 为 空 ， 非 空 时 ， 将 该 条 件 保存 在 查询 字符 串 中 
If Len(strMarketFilter) > 0 Then 
strSQL = strMarketFilter 
End If 
' 检 查 品 牌 名 查询 条 件 是 否 为 空 
If Len(strMarkFilter) > 0 Then 
' 当 查询 字符 串 有 数据 时 ， 将 字符 串 与 品牌 名 查询 条 件 连接 ， 否 则 直接 将 该 字符 串 赋 给 总 查询 字符 串 
IfLen(strSQL) > 0 Then 
strSQL = "(" & strSQL & ") and " & "(" & strMarkFilter & ")" 
Else 
strSQL = strMarkFilter 
End 上 f 
End If 
' 检 查 产品 型 号 名 查询 条 件 是 否 为 空 
If Len(strProductFilter) > 0 Then 
' 当 查询 字符 串 有 数据 时 ， 将 字符 串 与 产品 型 号 查询 条 件 连接 ， 否 则 直接 将 该 字符 串 赋 给 总 查询 字符 串 
上 fLen(strSQL) > 0 Then 
strSQL = "(" & strSQL & ") and " & "(" & strProductFilter & ")" 
Else 
strSQL = strProductFilter 
End 上 f 
End If 
' 检 查 产品 尺寸 查询 条 件 是 否 为 空 
If Len(strSizeFilter) > 0 Then 
' 当 查询 字符 串 有 数据 时 ,将 字符 串 与 产品 尺寸 查询 条 件 连接 , 否则 直接 将 该 字符 串 赋 给 总 查询 字符 串 
If Len(strSQL) > 0 Then 
strSQL = "(" & strSQL & ") and " & "(" & strSizeFilter & ")" 
Else 
strSQL = strSizeFilter 
End If 
End If 
' 检 查 销售 数量 查询 条 件 是 否 为 空 
If Len(strNumberFilter) > 0 Then 
' 当 查询 字符 串 有 数据 时 ,将 字符 串 与 销售 数量 查询 条 件 连 接 , 否则 直接 将 该 字符 串 赋 给 总 查询 字符 串 
lf Len(strSQL) > 0 Then 
strSQL = "(" & strSQL & ") and " & "(" & strNumberFilter & ")" 
Else 
strSQL = strNumberFilter 
End If 
End 上 
' 检 查 销售 单价 查询 条 件 是 否 为 空 
If Len(strPriceFilter) > 0 Then 
' 当 查询 字符 串 有 数据 时 ， 将 字符 串 与 销售 单价 查询 条 件 连接 ， 否 则 直接 将 该 字符 串 赋 给 总 查询 字符 串 
IfLen(strSQL) > 0 Then 
strSQL = "(" & strSQL & ") and " & "(" & strPriceFilter & ")" 
Else 
strSQL = strPriceFilter 
End 上 f 
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End If 

' 检 查 销 售 日 期 查询 条 件 是 否 为 空 

If Len(strDateFilter) > 0 Then 
' 当 查询 字符 串 有 数据 时 ,将 字符 串 与 销售 日 期 查询 条 件 连 接 , 否则 直接 将 该 字符 串 赋 给 总 查询 字符 串 
If Len(strSQL) > 0 Then 

strSQL = "(" & strSQL & ") and " & "(" & strDateFilter & ")" 
Else 
strSQL = strDateFilter 

End 上 f 

End If 

End Sub 

代码 说 明 : 

口 ”从 流程 图 中 可 以 看 到 ， 需 要 对 每 一 个 单项 查询 条 件 都 进行 检测 ， 查 看 这 些 查 询 条 件 
是 否 为 空 ， 从 而 保证 最 终 的 总 查询 字符 串 得 到 正确 的 结果 。 在 该 段 代 码 中 没有 对 各 
个 单项 查询 条 件 写 入 数组 ， 因 而 只 能 使 用 逐个 检测 的 方式 实现 。 读 者 可 以 试 着 通过 
数组 的 方式 循环 检测 来 实现 同样 的 功能 。 

口 ”最终 得 到 的 总 查询 条 件 的 格式 应 该 是 : ( 某 单个 查询 条 件 )+( 某 单个 查询 条 件 )+……。 
其 中 的 括号 是 在 单项 查询 条 件 与 总 查询 条 件 都 非 空 情况 被 添加 进去 的 。 当 总 查询 条 
件 为 空 的 时 候 ， 仅 仅 出 现 了 一 个 单个 查询 条 件 ， 括 号 的 设置 没有 必要 ， 因 此 这 种 情 
况 下 舍 去 了 插 号 。 

口 实际 上 在 该 过 程 中 产生 的 总 查询 条 件 字符 串 还 不 是 完成 的 SQL 查询 语句 ， 这 里 得 到 
的 仅仅 是 其 中 的 条 件 部 分 ， 因 此 不 能 直接 使 用 该 总 查询 条 件 字符 串 完 成 SQL 查询 。 


9.3.4 数据 库 建立 与 更 新 过 程 代 码 设计 
前 面 在 数据 表 设 计 章节 提 到 商品 销售 数据 资料 表 的 结构 不 是 通过 手动 设计 的 ， 而 是 通过 


代码 设计 。 本 小 节 将 解释 该 段 代码 ， 该 段 代码 将 生成 商品 销售 数据 资料 表 的 结构 ， 并 且 它 还 
完成 该 表 的 添加 、 修 改 记录 操作 。 如 图 9-14 所 示 的 是 该 过 程 的 流程 图 。 


打开 数据 库 链接 
一 一 商品 销售 数据 资料 表 存 在 ? 
建立 资料 表 结 构 


是 


图 9-14 数据 库 建立 与 更 新 过 程 流 程 图 


7 


在 上 面 的 流程 图 


办 公 应 用 旨 党 之 禾 
Excel VBA 应 用 开发 经 典 案 例 2 


Ph， 编辑 表 记 录 过 程 如 何 被 执行 将 会 由 传递 到 总 过 程 的 参数 决定 。 因 


对 记录 的 编辑 工作 包含 了 新 建 、 修 改 、 删 除 操作 ， 因 而 该 过 程 共 包含 了 对 应 的 3 个 部 分 。 
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"建立 数据 库 与 数据 表 ， 向 数据 库 的 数据 表 中 输入 数据 


Sub RefreshDB(intOPMethod As Integer，_ 


Optional strMarket As String, _ 
Optional strMark As String, _ 
Optional strProduct As String, _ 
Optional strSize As String, _ 
Optional strNumber As String，_ 
Optional strPrice As String) 


Dim tdf As DAO.TableDef, fld As DAO.Field, lsFind As Boolean, rs As DAO.Recordset, db As 


DAO.Database 


Dim strSQL As String 
打开 数据 库 链 接 


Set db = OpenDataBase(ThisWorkbook.Path & \DB\DB.mdb") 
' 循 环 数据 库 中 所 有 的 表 对 象 ， 检 测 是 否 由 表 {t_Sale 存在 


isFind=False 


For Each tdf In db.TableDefs 
Iftdf.Name="t_Sale" Then 


lsFind 


= True 


Exit For 


End 上 
Next 


' 当 没有 找到 表 t_Sale 时 ， 在 数据 库 中 建立 该 表 
IfNot IsFind Then 
Set tdf = db.CreateTableDef(‘t_Sale”) 


Set fld = tdf.CreateField("MarketName", dbText, 50) 


tdf.Fields.Append fld 


Set fld = tdf.CreateField("Mark", dbText, 50) 


tdf.Fields.Append fld 


Set fld = tdf.CreateField("Product", dbText, 50) 


tdf.Fields.Append fld 


Set fld = tdf.CreateField("Size", dbText, 50) 


tdf.Fields.Append fd 


Set fld = tdf.CreateField("Number", dblntegen) 


tdf.Fields.Append fld 

Set fld = tdf.CreateField("Price", dbDouble) 
tdf.Fields.Append fd 

Set fld = tdf.CreateField("Date", dblntegen) 
tdf.Fields.Append fld 

Set fld = tdf.CreateField("ID", dbText, 14) 
tdf.Fields.Append fd 
db.TableDefs.Append tdf 


End 上 f 


' 对 商品 销售 数据 表 记 录 进 行 编 辑 
'intOPMethod---1 代表 新 建 记录 ，2 代表 修改 记录 ，3 代表 删除 记录 
Select Case intOPMethod 

' 新 建 记录 ， 新 建 不 需要 更 新 查询 结果 窗口 的 数据 显示 ， 因 为 新 建 只 在 销售 商品 时 发 生 


' 建 立 表 t_Sale 

' 设 置 商 场 名 称 字段 

' 将 商品 名 称 字段 添加 到 表 {t_Sale 中 
"设置 品牌 字段 

"将 品牌 名 称 字段 添加 到 表 {t_Sale 中 
"设置 产品 型 号 字段 

' 将 产品 型 号 字段 添加 到 表 {t_Sale 中 
"设置 产品 尺寸 字段 

' 将 产品 尺寸 字段 添加 到 表 t_Sale 中 
"设置 销售 数量 字段 

' 将 销售 数量 字段 添加 到 表 t_Sale 中 
"设置 销售 单价 字段 

' 将 销售 单价 字段 添加 到 表 t_Sale 中 
"设置 销售 日 期 字段 

"将 销售 日 期 字段 添加 到 表 t_Sale 中 
"设置 ID 字段 

' 将 ID 字段 添加 到 表 t_Sale 中 

' 将 表 t_Sale 添加 到 数据 库 中 


为 
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Case 1 
Set rs = tdf.OpenRecordset 和 打开 记录 集 
With rs 
.AddNew "添加 新 记录 
.Fields("MarketName") = strMarket 获取 商场 名 称 字段 
.Fields("Mark") = strMark 获取 品牌 名 称 字段 
.Fields("Product") = strProduct 获取 产品 型 号 字段 
.Fields("Size") = strSize 获取 产品 尺寸 字段 
.Fields("Number") = strNumber 获取 产品 数量 字段 
.Fields("Price") = strPrice 获取 产品 单价 字段 
.Fields("Date") = Format(Now, "DD") 获取 销售 时 间 字 段 
.Fields("ID") = Format(Now, "YYYYMMDDHHMMSS") 获取 记录 ID 字段 
.Update 更 新 记录 集 数据 
End With 
"修改 记录 
Case2 
strSQL = "select * from t_Sale where ID=" & arrEdited(7) ' 获 取 查 询 字符 串 
Set rs = db.OpenRecordset(strSQL) 获取 对 应 1D 的 记录 
With rs 
.MoveFirst 
.Edit "开始 编辑 记录 
.Fields("MarketName") = strMarket "修改 商场 名 称 字段 
.Fields("Mark") = strMark "修改 品牌 名 称 字段 
.Fields("Product") = strProduct "修改 产品 型 号 字段 
.Fields("Size") = strSize "修改 产品 尺寸 字段 
.Fields("Number") = strNumber 路 改 产品 数量 字段 
.Fields("Price") = strPrice 路 改 产品 单价 字段 
.Fields("Date") = Format(Now, "DD") 路 改 销 售 时 间 字段 
.Fields("ID") = arrEdited(7) 路 改 记录 ID 字段 
.Update 蝎 新 记录 集 数 据 
End With 


' 在 修改 记录 时 ， 可 能 用 户 是 修改 的 在 查询 结果 中 选择 了 部 分 结果 后 的 记录 。 这 些 记录 被 程序 存 
储 在 临时 表 中 ， 此 时 对 于 表 t_Sale 和 临时 表 的 数据 都 要 进行 更 新 ， 下 面 代码 是 更 新 临时 表 数 据 
If Not isSaveAll Then 

strSQL = "Select * from TempTable" & " where ID=" & arrEdited(7) 


Set rs = db.OpenRecordset(strSQL) 打开 临时 表 记 录 集 

' 开 始 修改 临时 记录 集 ， 修 改 步骤 和 前 面 修改 t_Sale 类 似 

With rs 
.MoveFirst ' 移 动 记 录 集 指针 到 第 一 条 记录 
.Edit ' 开 始 编辑 记录 集 
.Fields("MarketName") = strMarket 指定 记录 MarketName 字段 的 值 
.Fields("Mark") = strMark 指定 记录 Mark 字段 的 值 
.Fields("Product") = strProduct 指定 记录 Product 字段 的 值 
.Fields("Size") = strSize 指定 记录 Size 字段 的 值 
.Fields("Number") = strNumber 指定 记录 Number 字段 的 值 
.Fields("Price") = strPrice 指定 记录 Price 字段 的 值 
.Fields("Date") = Format(Now, "DD") 指定 记录 Date 字段 的 值 
.Fields("ID") = arrEdited(7) 指定 记录 ID 字段 的 值 
.Update 更 新 记录 集 
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End With 
End lf 
Set rs = Nothing 


' 以 下 代码 是 更 新 查询 结果 窗 体 中 ListView 控件 的 显示 


' 在 修改 记录 时 ， 只 需要 更 新 在 ListView 控件 中 被 选择 的 记录 


With frmQryResult.ListViewQry.Selectedltem 


.Text = strMarket 
.Subltems(1) = strMark 
.Subltems(2) = strProduct 
.Subltems(3) = strSize 
.Subltems(4) = strNumber 
.Subltems(5) = strPrice 


.Subltems(6) = Format(Now, "D") 


.Subltems(7) = arrEdited(7) 
End With 


Case3 


"设置 被 选 定 修改 项 目的 第 一 个 子 项 目 
"设置 被 选 定 修改 项 目的 第 二 个 子 项 目 
"设置 被 选 定 修改 项 目的 第 三 个 子 项 目 
"设置 被 选 定 修改 项 目的 第 四 个 子 项 目 
"设置 被 选 定 修改 项 目的 第 五 个 子 项 目 
"设置 被 选 定 修改 项 目的 第 六 个 子 项 目 
"设置 被 选 定 修改 项 目的 第 七 个 子 项 目 


strSQL = "delete * from t_Sale where ID=" & arrEdited(7) "设置 删除 查询 字符 串 


db.Execute (strSQL) 
"删除 在 临时 表 中 的 对 应 记录 
If Not isSaveAll Then 


' 删 除 记录 


db.Execute ("delete * from TempDB" & " where ID=" & arrEdited(7)) 


End If 
' 根 据 具体 情况 获取 修改 后 的 记录 集 
IfisSaveAll Then 


Set rs = db.OpenRecordset("select * from t_Sale") 


Else 


' 打 开 到 表 t_Sale 的 记录 集 


Set rs = db.OpenRecordset("Select * from TempTable") ”和 打开 到 表 TempTable 的 记录 集 


End If 
' 重 置 ListView 控件 内 部 显示 项 目 


frmQryResult.ListViewQry.Listltems.Clear 


Do Until rs.EOF 
为 控件 添加 一 个 新 项 目 


' 清 除 控件 所 有 项 目 


Set itemList = frmQryResult.ListViewQry.Listltems.Add(Text:=rs.Fields("MarketName")) 


With itemList 


.Subltems(1) = rs.Fields("Mark") 
.Subltems(2) = rs.Fields("Product ) 
.Subltems(3) = rs.Fields("Size") 
.Subltems(4) = rs.Fields("Number") 
.Subltems(5) = rs.Fields("Price") 
.Subltems(6) = rs.Fields("Date") 
.Subltems(7) = rs.Fields("ID") 


rsCount = rsCount + 1 
rs.MoveNext 
End With 
Loop 


End Select 

' 清 除 临 时 变量 占用 空间 
Set rs = Nothing 

Set tdf = Nothing 


' 设 置 控件 第 一 个 子 项 目 
' 设 置 控件 第 二 个 子 项 目 
' 设 置 控件 第 三 个 子 项 目 
' 设 置 控件 第 四 个 子 项 目 
' 设 置 控件 第 五 个 子 项 目 
设置 控件 第 六 个 子 项 目 
' 设 置 控件 第 七 个 子 项 目 
' 记 忆 记 录 位 置 

"移动 到 记录 集 下 一 条 记录 
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Set fld = Nothing 

Set db = Nothing 

End Sub 

代码 说 明 : 

口 在 使 用 DAO 向 数据 库 添加 新 表 时 ， 首 先 需要 使 用 数据 库 对 象 的 CreateTableDef 方法 
建立 一 个 表 对 象 ， 然 后 使 用 该 表 对 象 的 CreateField 方法 为 表 建 立 字段 。 在 字段 信息 
建立 后 ， 需 要 使 用 表 对 象 的 Fields 集合 的 Append 方法 将 字段 添加 到 表 的 字段 集中 。 
所 有 的 字段 都 添加 完成 后 ， 需 要 使 用 数据 库 对 象 的 tableDefs 表 集 合 的 Append 方法 
将 表 添 加 到 数据 库 的 表 集 合 中 。 

口 编辑 记录 时 有 3 种 情况 ， 分 别 是 新 建 、 修 改 和 删除 。 新 建 操作 只 在 商品 销售 时 出 现 ， 
它 不 需要 完成 后 续 的 更 新 ListView 控件 显示 操作 。 在 修改 和 删除 记录 时 ， 还 需要 
虑 一 种 情况 。 系 统 中 允许 用 户 将 查询 结果 中 的 数据 选择 部 分 后 单独 显示 ， 并 且 将 
部 分 数据 单独 导出 。 该 功能 是 通过 建立 临时 表 实 现 的 ， 而 当 修 改 和 删除 属于 此 种 
况 下 的 数据 时 ， 修 改 数据 库 中 的 数据 时 需要 同时 修改 表 t_Sale 和 临时 表 。 


评说 届 


9.3.5 ”压缩 数据 库 代码 设计 


数据 库 文件 在 系统 使 用 一 段 时 间 后 ， 其 大 小 会 急剧 变 大 ， 这 不 完全 是 由 于 数据 增多 造成 
的 。DAO 提供 了 压缩 数据 库 的 功能 ， 此 功能 可 以 极 大 地 减少 数据 元 余 ， 并 且 可 以 加 快 数据 库 
的 访问 速度 。 以 下 是 该 过 程 的 代码 : 
"压缩 数据 库 
Public Sub ZipDB() 
On Error GoTo Exit_sub 
"压缩 商品 销售 登记 资料 表 
DAO.DBEngine.CompactDatabase ThisWorkbook.Path & \DB\DB.mdb"，_ 
ThisWorkbook.Path & \DB\tempDB.mdb", dbLangChineseSimplified 
Kill ThisWorkbook.Path & \DB\DB.mdb” 
FileCopy ThisWorkbook.Path & “DB\tempDB.mdb", ThisWorkbook.Path & \DB\DB.mdb” 
Kill ThisWorkbook.Path & "DB\tempDB.mdb" 
压缩 基本 信息 资料 表 
DAO.DBEngine.CompactDatabase ThisWorkbook.Path & \DBN\Info.mdb"，_ 
ThisWorkbook.Path & \DB\templnfo.mdb", dbLangChineseSimplified 
Kill ThisWorkbook.Path & \DB\info.mdb” 
FileCopy ThisWorkbook.Path & “DB\templnfo.mdb", ThisWorkbook.Path & "DB\Info.mdb" 
Kill ThisWorkbook.Path & “DB\templnfo.mdb" 
MsgBox "数据 库 文件 压缩 操作 成 功 !", vbOKOnly + vblnformation, "压缩 数据 库 " 
Exit Sub 
Exit_sub: 
MsgBox "请 检查 数据 库 文件 DB.mdb 和 Info.mdb 是 否 存在 !", vbOKOnly + vblnformation, "数据 库 
文件 丢失 " 
End Sub 


办 公 应 用 非常 之 狗 
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代码 说 明 : 

口 通过 CompatDatabase 方法 压缩 数据 库 时 , 它 将 原 数 据 文 件 压缩 后 保存 为 一 个 新 文件 。 
为 了 保证 这 些 数据 库 文件 的 名 称 在 压缩 前 后 不 发 生变 化 ， 需 要 将 原 数 据 库 文件 删除 ， 
然后 修改 新 数据 库 文件 为 原 数据 库 文件 的 名 称 。 

口 CompatDatabase 不 能 在 数据 库 文件 被 打开 状态 下 使 用 。 在 使 用 该 方法 时 ， 应 确保 没 
有 开启 需 压 缩 的 数据 库 文件 。 


9.4 基本 信息 设置 窗 体 设计 


窗 体 设 计 是 本 章 的 重点 。 在 前 面 设计 思路 小 节 中 已 经 对 本 实例 中 所 涉及 到 的 窗 体 做 了 大 
致 介绍 ， 随 后 的 各 节 将 详细 展开 。 对 于 实例 中 所 有 的 窗 体 ， 都 将 分 界面 设计 与 代码 设计 介绍 ， 
以 便于 理解 。 由 于 每 个 窗 体 的 代码 都 比较 多 ， 因 此 ， 本 章 将 对 每 一 个 窗 体 都 分 一 个 章节 介绍 ， 
并 且 代 码 介 绍 都 细 化 到 单个 控件 。 


9.4.1 基本 信息 设置 窗 体 界面 设计 


基本 信息 设置 窗 体 用 于 建立 基本 信息 ， 这 些 资 料 将 被 写 
入 基本 信息 资料 表 的 对 应 表 中 。 需 要 建立 的 基本 资料 包括 商 
场 名 称 、 品 牌 名 称 以 及 商品 名 称 。 商品 的 名 称 中 包含 了 尺寸， 
所 以 没有 建立 相应 的 尺寸 项 。 该 窗 体 的 界面 如 图 9-15 所 示 。 

表 9-1 列 出 了 该 窗 体 中 使 用 到 的 控件 的 控件 名 、 控 件 类 
型 以 及 用 途 的 说 明 。 


图 9-15 基本 信息 设置 窗 体 界面 

表 9-1 基本 信息 设置 窗 体 控件 列表 
说 了 明 

控件 包含 了 两 个 页 面 ， 在 各 个 页 面 中 ,分 别 对 商场 数据 和 品牌 、 产 品 型 号 
数据 进行 编辑 
控件 显示 已 经 建立 的 数据 。 当 在 多 页 控件 中 选择 商场 时 ,该 多 页 控件 显示 
的 是 已 建立 的 商场 资料 。 当 选择 品牌 与 产品 型 号 时 ,该 控件 显示 相应 的 已 
建立 数据 
单 击 该 按钮 , 将 把 对 应 多 页 控件 中 的 文本 框 数 据 写 入 资料 表 中 。 选 择 的 多 


控件 名 | 控件 类 型 


MultiPagel ”| 多 页 控件 


ListView ListView 控件 


binNew | 按钮 控件 。 | 页 控件 不 同 ， 写 入 的 表 也 不 同 
只 有 在 ListView 控件 中 选择 了 项 目 ， 该 按钮 才 会 被 激活 。 单 击 该 按钮 后 ， 
btnEdit 按钮 控件 


将 对 选择 项 目的 数据 进行 修改 
单 击 该 按钮 后 ， 将 把 选择 的 项 目 从 资料 表 中 删除 


btnDelete 按钮 控件 


建立 该 窗 体 的 步骤 如 下 
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(1) 在 Excel2007 的 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 插 入 一 个 新 
窗 体 , 如 图 9-16 所 示 。 TE RE ED Se 如 图 9-17 所 示 。 


EraSetup UserFora = 


图 9-16 插入 用 户 窗 体 图 9-17 修改 窗 体 名称 


(2) 在 工具 箱 中 选择 多 页 控件 ， 在 窗 体 上 单 击 鼠 标 左 键 并 拖 动 创建 一 个 新 多 页 控件 。 默 
认 的 多 页 控件 已 经 建立 了 两 个 页 。 随 后 在 属性 窗口 中 将 第 一 页 的 名 称 属性 设置 为 pMarket， 
Caption 设置 为 “商场 ”。 将 第 二 页 的 名 称 属性 设置 为 pMarkProduct，Caption 属性 设置 为 “ 品 
牌 与 产品 型 号 ”。 

(3) 选择 【商场 】 页 标签 ， 在 该 页 面 里 插入 一 个 标签 控件 和 一 个 文本 框 控件 。 随 后 在 属 
性 窗口 中 将 标签 控件 的 Caption 属性 设置 为 “商场 : ”。 文 本 框 控 件 的 名 称 属性 设置 为 txtMarket， 
其 SelectionMargin 属性 设置 为 False。 最 后 通过 鼠标 调整 好 控件 在 该 页 面 上 的 位 置 。 最 终 效 果 
如 图 9-18 所 示 。 

(4) 选择 【品牌 与 产品 型 号 】 页 标签 ， 在 该 页 面 里 插入 两 个 标签 控件 和 两 个 文本 框 控 件 。 
在 属性 窗口 中 将 第 一 个 标签 的 Caption 属性 设置 为 “品牌 ，”， 第 二 个 标签 的 Caption 属性 设 
置 为 “产品 型 号 ，”。 设 置 第 一 个 文本 框 控件 的 名 称 属 性 为 txtMark， 第 二 个 文本 框 控件 的 名 
称 属性 为 txtProduct。 然后 将 两 个 文本 框 控件 的 SelectionMargin 属性 都 设置 为 False。 最 后 调整 
好 控件 在 该 页 的 位 置 ， 最 终 效果 如 图 9-19 所 示 。 


图 9-18 ”商场 页 面 控件 调整 图 9-19 品牌 与 产品 型 号 页 面 控件 调整 


(5) 在 工具 箱 中 选择 按钮 控件 ， 然 后 在 窗 体 中 连续 插入 3 个 按钮 控件 。 在 属性 窗口 中 将 
3 个 按钮 的 名 称 属性 依次 设置 为 bnNew、btnEdit 和 btnDelete。 最 后 调整 好 3 个 按钮 在 窗 体 上 
的 位 置 。 
(6) 在 工具 箱 中 找到 ListView 控件 并 在 窗 体 中 插入 一 个 ListView 控件 。 在 属性 窗口 中 
设置 该 控件 的 名 称 属性 为 “ListView”。 最 后 调整 好 该 控件 大 小 即 可 。 最 终 效果 如 图 9-15 
所 示 。 
在 工具 箱 中 没有 找到 ListView 控件 时 ， 需 要 建立 引用 。 方 法 是 : 在 工具 菜单 中 选择 【 引 
用 】 命令， 在 打开 的 【引用 】 对 话 框 中 选择 Microsoft Windows Common Controls 6.0 项 目 ， 如 
图 9-20 所 示 。 若 在 左 侧 的 列表 框 中 没有 找到 该 项 目 ， 可 以 选择 【浏览 】， 按 照 所 示 定 位 中 显 
示 的 地 址 找到 该 文件 即 可 。 然 后 在 工具 箱 空白 区 域 右 击 ， 在 弹出 的 快捷 菜单 中 选择 【附加 控 
件 】 命 令 ， 再 在 打开 的 【附加 控件 】 中 选择 Microsoft ListView Control, version 6.0 项 目 并 单 击 
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Mierosoft ListVier Control, version 6.0 
C: WTIDOWS\systen32 WNSCONCTL OCX 


图 9-20 【引用 】 对 话 框 图 9-21 【附加 控件 】 对 话 框 
9.4.2 ” 窗 体 初始 化 代码 


基本 信息 设置 窗 体 需要 初始 化 的 内 容 不 多 。 当 窗 体 被 打开 后 ， 多 页 控件 默认 选择 的 是 商 
场 页 面 。 商 场 页 面 需要 激活 ， 另 外 ListView 控件 也 要 显示 已 建立 的 所 有 商场 信息 。3 个 按钮 的 
状态 也 需要 设置 ， 这 些 工作 都 可 以 在 窗 体 初始 化 过 程 中 找到 。 以 下 是 窗 体 的 初始 化 代码 : 

Private Sub UserForm_lnitialize() 

"激活 商场 页 面 

MultiPage1.Value =0 

"代码 触发 商场 页 面 单 击 事件 ， 完 成 ListView 列表 内 容 初始 化 以 及 按钮 状态 初始 化 

MultiPage1 Click 0 

单 击 ListView 控件 第 一 列 时 不 变 成 编辑 状态 

ListView.LabelEdit = IvwManual 

'ListView 控件 失去 焦点 时 仍 能 显示 选中 的 项 目 

ListView.HideSelection = False 

End Sub 

代码 说 明 : 

口 多 页 控件 的 页 面 单 击 事件 是 初始 化 过 程 中 的 一 个 主体 。 该 事件 完成 了 ListView 控件 
状态 与 内 容 初 始 化 以 及 按钮 的 状态 初始 化 工作 。 该 过 程 的 代码 在 本 节 后 续 部 分 进行 
介绍 。 

口 ListView 控件 的 LabelEdit 属性 可 以 控制 单 击 第 一 列 的 项 目 时 ， 是 否 进入 项 目的 编辑 
状态 。 该 属性 的 默认 值 为 lvwAutomatic， 设 置 该 值 将 会 自动 进入 编辑 状态 。 

口 ListView 控件 的 HideSelection 属性 可 以 控制 当 ListView 控件 失去 焦点 时 ， 控 件 中 原 
来 被 选中 的 项 目 是 否 仍然 处 于 被 选中 状态 。 设 置 为 False 时 ， 控 件 失去 焦点 仍 能 显示 
选中 的 项 目 。 

多 页 控件 的 页 面 被 单 击 时 将 触发 多 页 控件 页 面 单 击 事件 ， 该 事件 还 传递 了 一 个 Index 参 

数 ， 该 参数 指定 了 页 面 的 索引 。 该 页 面 单 击 事件 的 代码 很 长 ， 在 阅读 之 前 ， 首 先 应 了 解 其 工 
作 流 程 。 该 过 程 的 流程 图 如 图 9-22 所 示 。 
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打开 数据 库 链 接 


链接 到 表 t_MarketInfo 链接 到 表 t_ProductInfo 


重 置 ListView 控 件 
状态 与 列表 内 容 


设置 按钮 的 状态 


图 9-22 多 页 控件 单 击 事件 过 程 流 程 图 


需要 说 明 的 是 : 在 图 9-22 中 ， 重 置 ListView 控件 状态 与 列表 内 容 与 设置 按钮 的 状态 两 个 
步 又。 对 于 单 击 不 同 页 面 时 其 完成 的 实际 工作 是 不 一 样 的 ， 因 为 它们 都 需要 针对 不 同 页 面 ， 
使 用 链接 到 的 不 同 表 的 数据 。 以 下 是 该 单 击 事件 过 程 的 代码 : 

Private Sub MultiPage1_Click(ByVal Index As Long) 

Dim db As DAO.Database, rs As DAO.Recordset 


Dim itemList As Listltem 


' 打 开 数 据 库 链 接 
Set db = OpenDataBase(ThisWorkbook.Path & "\DB\Info.mdb") 


' 根 据 页 面 索引 完成 各 自 的 初始 化 工作 ， 商 场 页 面 的 索引 为 0 


lf Index Then 
' 初 始 化 ListView 控件 状态 
With ListView 
.Gridlines = True ' 显 示 网 格 线 
.FullRowSelect = True ' 允 许 整 行 选择 
.MultiSelect = False ' 不 允许 多 行 选择 
.LabelEdit = lvwManual 单 击 ListView 控件 第 一 列 时 不 变 成 编辑 状态 
.View = lvwReport 'ListView 显示 模式 为 报告 模式 
"设置 ListView 控件 标题 
With .ColumnHeaders 
.Clear 
.Add Text:=" 品 牌 ", Width:=74 第 一 列 列 头 显示 为 品牌 ， 宽 度 为 74 
.Add Text:=" 产 品 型 号 ", Width:=74 第 二 列 列 头 显示 为 产品 型 号 ， 宽 度 为 74 
End With 
End With 


"获取 连接 到 t_Productlnfo 表 的 记录 集 ， 并 且 该 记录 集 按照 品牌 名 进行 排序 
Set rs = db.OpenRecordset("select * ffomt_Productlnfo order by Mark") 
"清空 ListView 控件 列表 内 容 

ListView.Listltems.Clear 

' 将 记录 集中 所 有 项 目 写 入 ListView 控件 中 


Do Until rs.EOF 
为 ListView 控件 添加 新 项 ， 该 项 使 用 记录 集 的 品牌 名 建立 ， 显 示 在 ListView 控件 第 一 列 


Set itemList = ListView.Listltems.Add(Text:=rs.Fields("Mark")) 
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为 新 项 添加 子 项 ， 该 子 项 使 用 记录 集 的 产品 名 称 建立 ， 显 示 在 ListView 控件 第 二 列 
itemList.Subltems(1) = rs.Fields("Product") 
rs.MoveNext "将 记录 集 的 指针 移 到 下 一 条 记录 
Loop 
"设置 按钮 的 可 用 状态 
If Len(Trim(txtMark.Text)) And Len(Trim(txtProduct. Text)) Then 
' 当 品牌 名 称 与 产品 名 称 文本 框 都 输入 内 容 时 ， 所 有 按钮 可 用 ， 否 则 都 不 可 用 


btnNew.Enabled = True 新 建 按钮 可 用 
btnEdit.Enabled = True "编辑 按钮 可 用 
btnDelete.Enabled = True ' 删 除 按钮 可 用 

Else 
btnNew.Enabled = False 新 建 按钮 不 可 用 
btnEdit.Enabled = False 编辑 按钮 不 可 用 
btnDelete.Enabled = False ' 删 除 按钮 不 可 用 

End 上 f 

Else 

' 初 始 化 ListView 控件 状态 

With ListView 
.Gridlines = True "显示 网 格 线 
.FullRowSelect = True ' 允 许 整 行 选择 
.MultiSelect = False ' 不 允许 多 行 选择 
.LabelEdit = lwwManual 单 击 ListView 控件 第 一 列 时 不 变 成 编辑 状态 
.View = IvwReport 'ListView 显示 模式 为 报告 模式 
"设置 ListView 控件 标题 
With .ColumnHeaders 

.Clear 
.Add Text:=" 商 场 名 ", Width:=74 第 一 列 列 头 显示 为 商场 名 ， 宽 度 为 74 

End With 

End With 


"获取 连接 到 t_Marketlnfo 表 的 记录 集 ， 并 且 该 记录 集 按照 商场 名 进行 排序 
Set rs = db.OpenRecordset("select * ffomt_Marketlnfo order by MarketName") 
"清空 ListView 控件 列表 内 容 
ListView.Listltems.Clear 
' 将 记录 集中 所 有 项 目 写 入 ListView 控件 中 
Do Until rs.EOF 
为 ListView 控件 添加 新 项 ， 该 项 使 用 记录 集 的 商场 名 建立 
Set itemList = ListView.Listltems.Add(Text:=rs.Fields("MarketName")) 


rs.MoveNext ' 将 记录 集 的 指针 移 到 下 一 条 记录 
Loop 
"设置 按钮 的 可 用 状态 
btnNew.Enabled = Len(Trim(txtMarket. Text)) "设置 新 建 按钮 可 用 状态 
btnEdit.Enabled = Len(Trim(txtMarket.Text)) "设置 编辑 按钮 可 用 状态 
btnDelete.Enabled = Len(Trim(txtMarket. Text)) "设置 删除 按钮 可 用 状态 


End If 

"清除 临时 对 象 变量 占用 的 内 存 空间 
Set itemList = Nothing 

Set rs = Nothing 

Set db = Nothing 

End Sub 
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代码 说 明 : 

口 要 使 用 数据 库 文件 中 的 表 建 立 记录 集 ， 首 先 需要 链接 到 数据 库 。 通 过 DAO 对 和 象 的 
OpenDataBase 函数 可 以 完成 该 工作 ， 函 数 获取 数据 库 文件 的 位 置信 息 即 可 获取 数据 
库 对 象 。 

口 程序 中 记录 集 的 获取 是 通过 使 用 SQL 语句 实现 的 ， 其 中 的 Order By 关键 字 指 定 了 记 
录 集 将 按照 哪个 字段 进行 排序 。 

口 要 为 ListView 控件 添加 标题 时 ， 应 该 使 用 该 控件 的 ColumnHeaders 集合 对 象 ， 然 后 
使 用 该 对 象 的 Add 方法 建立 新 的 标题 。 这 些 标题 的 排列 顺序 将 按照 代码 的 先后 顺序 
出 现 ， 要 清空 标题 只 需要 使 用 该 对 象 的 Clear 方法 。 

口 要 为 ListView 控件 添加 项 目 时 ， 需 要 使 用 该 对 象 的 ListItems 集合 对 象 ， 然 后 使 用 该 
对 象 的 Add 方法 添加 新 项 目 。 该 新 项 目 建立 时 ， 只 能 指定 第 一 列 的 内 容 。 要 为 新 项 
目 添加 其 他 列 的 内 容 ， 需 要 使 用 该 新 项 目 SubItems 集合 来 依次 指定 。 


9.4.3 新建 按钮 代码 设计 


窗 体 中 的 【新 建 】 按 钮 对 于 选择 的 不 同 页 面 将 会 采取 不 同 的 操作 。 当 用 户 选 择 的 是 商场 
页 面 时 ，【 新 建 】 按 钮 将 链接 商场 销售 数据 资料 表 ， 为 该 表 添 加 新 记录 ;， 当 用 户 选 择 的 是 品 
牌 与 产品 型 号 页 面 时 , 【新 建 】 按 钮 将 链接 商品 信息 资料 表 ， 并 向 该 表 添 加 新 记录 。 如 图 9-23 
所 示 的 是 该 【新 建 】 按 钮 的 运行 流程 图 。 


图 9-23 【新 建 】 按 钮 运行 流程 图 


Private Sub btnNew_Click() 
Dim db As DAO.Database, rs As DAO.Recordset 
链接 数据 库 
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Set db = OpenDataBase(ThisWorkbook.Path & "DB\Info.mdb") 
' 根 据 不 同情 况 分 别 完 成 添加 新 记录 与 更 新 窗口 显示 工作 
If MultiPage1.Selectedltem.Index Then 
' 当 用 户 选择 品牌 与 产品 型 号 页 面 时 ， 从 商品 信息 表 中 获取 满足 条 件 的 记录 集 
' 这 个 条 件 是 指 品牌 与 产品 型 号 与 页 面 文 本 框 中 输入 数据 相等 
Set rs = db.OpenRecordset("select * from t_ProductInfo where Mark=" & txtMark. Text & " and 
Product="" & txtProduct.Text & "order by Mark") 
"检查 获得 的 记录 集 是 否 有 记录 
If rs.RecordCount > 0 Then 
MsgBox "该 项 已 经 存在 ! ", vbOKOnly + vblnformation 


Else 
' 当 输入 的 信息 资料 在 商品 资料 表 中 不 存在 时 ， 将 新 资料 添加 到 表 中 
rs.AddNew "添加 新 记录 
rs.Fields("Mark") = txtMark.Text ' 将 品牌 信息 写 入 表 中 的 品牌 字段 
rs.Fields("Product") = txtProduct.Text ' 将 商品 名 称 写 入 表 中 的 商品 名 称 字段 


"以 下 代码 将 根据 商品 名 称 获取 该 产品 的 尺寸 信息 ， 并 将 该 信息 写 入 商品 信息 表 中 
' 在 产品 型 号 最 左 端 开始 查询 ， 首 次 出 现 的 连续 两 个 阿拉 伯 数 字 即 为 该 产品 尺 十 
i=1 

Do Untili = Len(txtProduct.Text) 


j= Asc(Mid(txtProduct.Text, i, 1)) ' 获 取 产 品 型 号 第 i 个 字符 的 ASCII 码 
fj >= 48 Andj <= 57 Then 
k = Asc(Mid(txtProduct. Text, i + 1, 1)) ' 当 第 i 个 字符 为 数字 , 检查 第 i+1 个 字符 


Ifk >= 48 And k <= 57 Then 
rs.Fields("Size") = "S" & Mid(txtProduct.Text, i, 2) ' 将 该 尺寸 前 面 添加 “S” 后 


写 入 表 中 
Exit Do "找到 尺寸 后 直接 退出 循环 
End If 

End If 

i=i+1 ' 累 加 循环 变量 
Loop 
rs.Update "更 新 记录 集 
MultiPage1_Click MultiPage1.Selectedltem.Index “更 新 窗口 显示 

End ff 


Else 
"从 商场 信息 资料 表 中 获取 商场 名 称 字段 与 商场 名 称 文本 框 相 等 的 记录 集 
Set rs = db.OpenRecordset("select * from t_Marketlnfo where MarketName=" & txtMarket. Text & "™") 
' 检 查 该 记录 集 是 否 为 空 ， 为 空 时 ， 添 加 新 记录 
If rs.RecordCount > 0 Then 
MsgBox "该 项 已 经 存在 ! ", vbOKOnly + vblnformation 


Else 
rs.AddNew ' 添 加 新 记录 
rs.Fields("MarketName") = txtMarket. Text ' 写 入 商场 名 称 
rs.Update 更 新 记录 集 
MultiPage1_Click MultiPage1.Selectedltem.Index ”' 更 新 窗口 显示 
End If 
End If 
"清除 临时 对 象 占用 的 内 存 空间 


Set rs = Nothing 
Set db = Nothing 
End Sub 
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代码 说 明 : 

口 在 检查 表 中 是 否 有 相同 记录 存在 时 ， 是 通过 从 表 中 获取 满足 指定 条 件 的 记录 集 做 到 
的 。 这 些 记录 集 的 部 分 字段 应 该 和 页 面 里 文本 框 的 内 容 一 致 。 当 该 记录 集 有 记录 时 
即 说 明 已 经 在 表 中 建立 该 资料 的 信息 ， 这 个 时 候 将 获得 提示 信息 ， 否 则 将 进入 写 入 
操作 。 

口 ”该 系统 中 商品 的 尺寸 实际 上 已 经 包含 在 了 商品 型 号 中 。 商 品 型 号 中 首次 出 现 的 连续 
两 位 阿拉 伯 数 字 就 是 该 商品 的 尺寸 。 程 序 中 通过 一 个 Do…Until 循环 检测 商品 型 号 中 
所 有 字符 的 ASCII 码 。 当 发 现 有 连续 两 个 阿拉 伯 数 字 出 现时 ， 立 即 退出 循环 ， 从 而 
获取 正确 的 尺寸 资料 。 

口 在 使 用 DAO 对 象 新 建 、 修 改 活 删除 记录 时 , 当 完 成 了 所 有 的 操作 后 , 务必 使 用 Update 
更 新 该 记录 集 。 只 有 当 使 用 了 该 方法 后 ， 该 记录 集 所 做 的 新 建 、 修 改 和 删除 操作 才 
能 最 终 体 现 出 来 。 

口 在 添加 了 新 的 记录 后 ， 在 ListView 控件 中 将 立即 显示 该 新 记录 。 这 里 的 方法 是 通过 
再 次 调用 该 页 面 的 单 击 事件 完成 的 ， 该 事件 的 详细 代码 已 经 在 前 面 做 过 介绍 。 它 将 
会 重新 设置 ListView 控件 的 状态 和 内 容 以 及 各 个 按钮 的 状态 。 


9.4.4 ”编辑 按钮 代码 设计 


单 击 【 编 辑 】 按 钮 后 ， 程 序 完成 的 操作 大 体 上 和 【新 建 】 按 钮 一 致 ， 它 也 需要 对 记录 进 
行 存在 性 检测 ， 不 过 这 里 是 要 对 修改 后 的 记录 进行 存在 性 检测 。【 编 辑 】 按 钮 单 击 事件 过 程 
的 流程 图 如 图 9-24 所 示 。 


图 9-24 【编辑 】 按 钮 单 击 事件 过 程 流程 图 


办 公 应 用 匡 党 之 狗 . 
”Excel VBA 应 用 开发 经 典 案例 汪汪 


从 图 9-24 中 可 以 看 出 ， 该 按钮 的 程序 执行 流程 和 【新 建 】 按 钮 的 执行 流程 相差 不 大 。 实 
际 上 该 部 分 的 代码 都 几乎 一 样 。 以 下 是 该 单 击 事件 的 程序 代码 : 


Private Sub btnEdit_Click() 
Dim db As DAO.Database, rs As DAO.Recordset 
' 链 接 数据 库 
Set db = OpenDataBase(ThisWorkbook.Path & "DB\Info.mdb") 
' 根 据 不 同情 况 分 别 完成 记录 编辑 与 更 新 窗口 显示 工作 
If MultiPage1.Selectedltem.Index Then 
' 当 用 户 选择 品牌 与 产品 型 号 页 面 时 ， 从 商品 信息 表 中 获取 满足 条 件 的 记录 集 
' 这 个 条 件 是 指 品牌 与 产品 型 号 与 页 面 文 本 框 中 输入 数据 相等 
Set rs = db.OpenRecordset("select * from t_ProductInfo where Mark=" & txtMark. Text & " and 
Product="" & txtProduct. Text & "") 
' 检 查获 得 的 记录 集 是 否 有 记录 
If rs.RecordCount > 0 Then 
MsgBox "该 修改 结果 已 经 存在 ! ", vbOKOnly + vblnformation 
Exit Sub 
End 上 f 
"打开 满 足 原 选择 项 目 条 件 的 记录 集 ， 然 后 修改 该 记录 集中 的 数据 
Set rs = db.OpenRecordset("select * from t_Productlnfo where Mark=" & ListView.Selectedltem.Text 
&"and Product=" & ListView.Selectedltem.Subltems(1) & ”order by Mark") 


rs.Edit ' 开 启 记录 集 的 编辑 模式 
rs.Fields("Mark") = txtMark. Text "修改 品牌 名 称 
rs.Fields("Product") = txtProduct.Text "修改 产品 型 号 
"以 下 代码 将 获取 产品 尺寸 
i=1 "初始 化 循环 变量 
Do Untili = Len(txtProduct Text) "逐个 检测 产品 型 号 字符 串 的 每 一 个 字符 
j= Asc(Mid(txtProduct. Text, i, 1)) "获取 第 i 个 字符 的 ASCII 码 
Ifj >= 48 Andj <= 57 Then "检测 第 i 个 字符 是 否 为 数字 
k= Asc(Mid(txtProduct.Text, i + 1, 1)) "获取 第 i+1 个 字符 的 ASCII 码 
fk>= 48 And k <= 57 Then ' 检 测 第 +1 个 字符 是 否 为 数字 
rs.Fields("Size") = "S" & Mid(txtProduct.Text, i, 2) ”' 设 置 Size 字段 的 值 
Exit Do 
End If 
End If 
i=i+1 "循环 变量 加 1 
Loop 
rs.Update 更 新 记录 集 
MultiPage1_Click MultiPage1.Selectedltem.Index 蝎 新 窗口 显示 
Else 


' 从 商场 信息 资料 表 中 获取 商场 名 称 字 段 与 商场 名 称 文本 框 相等 的 记录 集 
Set rs = db.OpenRecordset("select * from t_ Marketlnfo where MarketName=" & txtMarket. Text & "") 
' 检 查 该 记录 集 是 否 为 空 ， 为 空 时 ， 开 始 修改 原 记录 
If rs.RecordCount > 0 Then 
MsgBox "该 项 已 经 存在 ! ", vbOKOnly + vblnformation 
Exit Sub 
End 上 f 
"获取 需要 修改 的 记录 的 记录 集 
Set rs = db.OpenRecordset("select * ffomt_Marketlnfo where MarketName=" & 
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ListView.Selectedltem 


rs.Edit "开启 记录 集 的 编辑 模式 
rs.Fields("MarketName") = txtMarket. Text "修改 商场 名 称 
rs.Update ' 更 新 记录 集 
MultiPage1_Click MultiPage1.Selectedltem.Index 更 新 窗口 显示 

End 上 f 

"清除 临时 变量 占用 的 内 存 资 源 

Set rs = Nothing 

Set db = Nothing 

End Sub 


代码 说 明 : 

口 ”该 段 代码 与 【新 建 】 按 钮 的 代码 有 很 多 部 分 是 相似 的 ， 这 里 不 再 加 以 说 明 。 不 同 的 
地 方 是 ， 当 检测 到 修改 后 的 数据 在 表 中 没有 对 应 记录 时 ， 才 开始 编辑 记录 工作 。 要 
开始 编辑 记录 ， 又 需要 重新 获取 新 的 记录 集 ， 该 记录 集 满足 的 条 件 应 该 和 ListView 
控件 中 选择 项 目的 数据 相同 ,此 时 的 SQL 语句 使 用 了 诸如 ListView.SelectedItem.Text 
这 样 的 表达 式 。 

口 、 和 记录 集 新 建 记录 后 需要 使 用 Update 更 新 记录 集 一 样 ， 编 辑 记录 集 完成 也 需要 使 用 
记录 集 的 Update 方法 更 新 记录 集 。 不 然 将 会 发 生 十 分 奇怪 的 事情 : 本 来 已 经 “完成 ” 
了 新 建 、 编 辑 工作 ， 为 何 数据 没有 被 建立 、 修 改过 来 呢 ? 


9.4.5 删除 按钮 代码 设计 


单 击 【删除 】 按 钮 后 ， 程 序 需 要 完成 的 操作 没有 新 建 和 编辑 操作 那么 复杂 。 它 不 需要 检 
测 记录 是 否 存 在 ， 因 为 该 记录 一 定 存在 于 表 中 。 只 有 在 ListView 控件 中 选择 了 项 目 后 ， 该 按 
钮 才 被 激活 。 一 旦 在 ListView 控件 中 选择 了 项 目 ， 说 明 在 表 中 一 定 有 记录 存在 ， 因 为 该 项 目 
正 是 从 表 中 获取 的 。 该 按钮 的 单 击 事件 流程 十 分 简单 ， 代 码 如 下 : 
Private Sub btnDelete_Click() 
Dim db As DAO.Database 
链接 数据 库 
Set db = OpenDataBase(ThisWorkbook.Path & "\DB\Info.mdb") 
If MultiPage1.Selectedltem.Index Then 
' 在 产品 信息 资料 表 中 删除 满足 条 件 记 录 
db.Execute ("Delete * from t_Productlnfo where Mark=" & ListView. Selectedltem. Text & " and 
Product=" & ListView.Selectedltem.Subltems(1) & " order by Mark") 
' 更 新 窗口 显示 
MultiPage1_Click MultiPage1.Selectedltem.Index 
Else 
' 在 商场 名 称 表 中 删除 满足 条 件 的 记录 
db.Execute ("Delete * from t_Marketlnfo where MarketName=" & ListView. Selectedltem. Text & "") 
' 更 新 窗口 显示 
MultiPage1_Click MultiPage1.Selectedltem.Index 
End If 


二 


办 公 应 用 意 党 之 稍 
Excel VBA 应 用 开发 经 典 案例 
"清除 临时 变量 占用 空间 


Set db = Nothing 
End Sub 


代码 说 明 : 
代码 中 删除 记录 时 ,使 用 了 DAO 数据 库 对 象 的 Execute 方法 直接 执行 SQL 语句 。 这 里 执 


行 的 正 是 Delete 语句 。 


9.4.6 ”ListView 控件 代码 设计 


当 用 户 在 ListView 控件 中 选择 了 项 目 时 ， 该 选 定 项 目的 数据 应 该 立即 被 显示 在 多 页 控件 


的 对 应 的 页 面 文本 框 中 ， 以 便 用 户 对 该 记录 进行 修改 操作 。 该 编程 操作 十 分 简单 。 下 面 是 该 
控件 项 目 单 击 事件 的 代码 : 


作 
冲 


Private Sub ListView_ltemClick(ByVal ltem As MSComctlLib.Listltem) 
If MultiPage1.Selectedltem.Index Then 
' 单 击 品牌 与 产品 型 号 页 面 时 ， 将 ListView 控件 中 选 定 项 目的 品牌 与 产品 型 号 写 入 多 页 控件 的 对 应 


文本 框 中 
txtMark. Text = ltem. Text ' 写 入 品牌 名 称 
txtProduct.Text = ltem.Subltems(1) ' 写 入 产品 型 号 
Else 


' 单 击 商 场 页 面 时 ， 将 ListView 控件 中 选 定 项 目的 商场 名 称 写 入 多 页 控件 的 文本 框 中 
txtMarket. Text = ltem. Text 

End If 

"设置 各 个 按钮 的 状态 

btnNew.Enabled = True 

btnEdit.Enabled = True 

btnDelete.Enabled = True 

End Sub 


9.5 商品 销售 数据 登记 窗 体 设计 


商品 销售 数据 登记 窗 体 在 系统 中 是 一 个 多 用 途 窗 体 。 它 不 仅 被 用 来 完成 销售 数据 登记 工 


， 在 查询 销售 记录 时 ， 也 可 以 通过 该 窗 体 完成 编辑 操作 。 该 窗 体 在 不 同情 况 下 的 功能 并 不 
突 ， 后 者 使 用 到 的 新 功能 对 于 前 者 是 无 法 使 用 的 。 


9.5.1 商品 销售 数据 登记 窗 体 界面 设计 


同 
分 
如 


前 面 讲 过 该 窗 体 将 被 用 于 两 种 不 同情 况 ， 但 它们 所 需要 的 要 素 是 一 样 的 ， 因 此 才 有 使 上 


一 窗 体 的 事情 发 生 。 无 论 销 售 数据 登记 ， 还 是 后 面 查询 后 的 编辑 修改 操作 ， 都 使 用 到 了 部 


固定 数据 。 这 部 分 数据 包括 商场 名 称 、 品 牌 名 称 、 产 品 型 号 、 尺 寸 、 数 量 、 单 价 6 个 要 素 。 


图 9-25 和 图 9-26 所 示 的 是 该 窗 体 在 不 同情 况 下 的 界面 。 


Ah 
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EEC 到 到 
三 半 和 失 区 一 一 站 HE 一 一 
| 商场 名 称 : | 大 酒 发 司 北 | 
曲牌: | [= | 2 [三 了 可 | 请 
产品 型 号 : Ess 村 [本 产品 型 号 : es 司 区 到 
md 所 ES Rd 抽 一 一 一 一 | 中 
数量 | 关闭 数量 | EEE 关闭 
单价 单价 

Ee | 

EE : 
窗口 刚 被 初始 化 | 军品 风流 初 好 化? 

图 9-25 ”商品 销售 数据 登记 窗 体 界面 图 9-26 编辑 记录 状态 下 界面 


如 图 9-25 所 示 是 在 销售 数据 登记 情况 下 打开 的 窗 体 显示 情况 ， 其 中 的 【删除 】 按 钮 被 设 
和 置 为 不 可 用 。 如 图 9-26 所 示 的 是 在 编辑 记录 状态 下 该 窗 体 的 界面 ， 其 中 的 【删除 】 按 钮 已 经 
变 成 可 用 状态 。 

表 9-2 列 出 了 该 窗 体 中 使 用 到 的 各 个 控件 的 控件 名 称 、 控 件 类 型 以 及 功能 说 明 。 


表 9-2 商品 销售 数据 登记 窗 体 控件 列表 


控件 名 称 | 控件 类 型 功能 说 明 

Framel 框架 控件 该 框架 控件 用 于 包含 资料 输入 区 中 所 有 项 目 

combMarket | 复合 框 控件 控件 显示 所 有 不 重复 的 商场 名 称 列表 ,用 户 通过 该 控件 获取 对 应 的 商场 名 称 。 
在 其 左 方 有 一 标签 控件 提示 该 控件 的 作用 

combMark 复合 框 控件 | 控件 显示 所 有 非 重 复 的 品牌 名 称 列表 ， 用 户 通过 该 控件 获取 对 应 的 品牌 名 称 
combProduct | 复合 框 控件 | 控件 显示 所 有 非 重 复 的 产品 型 号 列表 ， 用 户 通过 该 控件 获取 对 应 的 产品 型 号 


txtSize 文本 框 控件 | 控件 显示 的 是 对 应 产品 型 号 的 产品 尺寸 ， 该 文本 框 是 不 可 编辑 的 
txtCount 文本 框 控件 | 控件 用 于 输入 销售 商品 的 数量 
txtPrice 文本 框 控件 | 控件 用 于 输入 销售 商品 的 单价 信息 
Frame2 框架 控件 该 控件 用 于 包含 窗口 的 提示 信息 
pe 在 销售 商品 时 选择 该 按钮 将 将 销售 商品 信息 写 入 商品 销售 资料 表 中 。 当 编辑 
btnOK 按钮 控件 


销售 信息 时 ， 该 按钮 将 完成 对 商品 销售 信息 的 编辑 工作 

该 按钮 只 在 对 商品 销售 信息 进行 编辑 时 才能 使 用 ， 它 将 把 商品 的 销售 资料 信 
息 从 商品 销售 资料 表 中 删除 

btnCancle 按钮 控件 选择 该 按钮 后 将 退出 窗口 


btnDelete 按钮 控件 


建立 该 窗 体 的 步骤 如 下 : 

(1) 在 Excel2007 的 VBE 开发 环境 中 依次 选择 【插入 】|【 用 户 窗 体 】 命 令 创 建 一 个 新 
窗 体 。 随 后 在 属性 窗口 中 将 其 名 称 属性 设置 为 fmInput。 

(2) 在 工具 箱 中 选择 框架 控件 。 在 窗 体 上 单 击 鼠 标 左 键 并 拖 动 建立 一 适当 大 小 的 框架 控 
件 。 然 后 在 属性 窗口 中 将 该 控件 的 名 称 设置 为 Framel 。 

(3) 在 工具 箱 中 选择 标签 控件 。 然 后 在 Framel 框架 控件 中 连续 插入 6 个 标签 控件 。 随 
后 在 属性 窗口 中 设置 这 些 标签 的 Caption 属性 依次 为 : “商场 名 称 : ”、“ 品 牌 : ”、“ 产 品 
型 号 ，”、“ 尺 寸 ，”、“ 数 量 :， ”和 “单价 ，”。 

(4) 选中 所 有 的 标签 控件 ， 方 法 是 按 住 Ctrl 键 依次 单 击 各 个 标签 。 然 后 在 属性 窗口 中 将 
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这 些 标签 的 Width 属性 即 宽度 设置 为 50。 这 个 数值 的 大 小 可 以 视 具体 情况 而 定 。 然 后 在 这 些 
标签 上 右 击 ， 在 弹出 的 快捷 菜单 中 依次 选择 【对 齐 】|【 左 对 齐 】 命 令 ， 如 图 9-27 所 示 。 保 持 
所 有 控件 被 选中 状态 ， 在 VBE 开发 环境 中 依次 选择 【格式 】| 【垂直 间距 】| 【相同 】 命令 ,， 效 
果 如 图 9-28 所 示 。 


FU 
居中 FO 
FR) 
BAD 

中 辣 对 齐 (W) 
度 污 对 齐 (B) 
ARG 
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图 9-27 水 平 对 齐 窗 体 控件 图 9-28 科 直 对 齐 窗 体 控件 


(5) 在 工具 箱 中 选择 复合 框 控件 并 在 Framel 框架 控件 中 连续 添加 3 个 复合 框 控件 。 在 
属性 窗口 中 设置 3 个 复合 框 控件 的 名 称 属 性 依次 为 combMarket、combMark 和 combMark。 然 
后 在 工具 箱 中 选择 文本 框 控 件 并 添加 3 个 文本 框 控件 。 在 属性 窗口 中 设置 3 个 文本 框 控 件 的 
名 称 属性 依次 为 ktSize、txtCount 和 txtPrice。 

(6) 选中 所 有 的 复合 框 与 文本 框 控件 ， 在 属性 窗口 中 将 这 些 控 件 的 SelectionMargin 属性 
设置 为 False。 选 中 的 方法 与 步骤 (4) 相同 ， 这 里 不 再 多 做 说 明 。 然 后 右 击 这 些 控 件 ， 在 弹出 
的 快捷 菜单 中 依次 选择 【对 齐 】|【 左 对 齐 】 命令 。 保 持 所 有 控件 被 选中 状态 ， 在 VBE 开发 环 
境 中 依次 选择 【格式 】| 【垂直 间距 】| 【相同 】 命 令 。 随 后 再 选中 所 有 复合 框 控 件 ， 在 属性 窗 
口中 设置 Width 属性 为 120， 该 数值 视 具 体 情况 而 定 。 然 后 再 选中 所 有 文本 框 控件 ， 在 属性 窗 
口中 设置 Width 属性 为 106。 

(7) 在 工具 箱 中 选择 按钮 控件 并 在 窗 体 中 连续 添加 3 个 按钮 控件 。 在 属性 窗口 中 设置 这 
些 按钮 的 名 称 属性 依次 为 bbnOK、btnDelete 和 btnCancel。 然后 选中 并 右 击 刚 创建 的 3 个 按钮 ， 
在 弹出 的 快捷 菜单 中 依次 选择 【统一 尺寸 】|【 两 者 都 相同 】 命 令 。 再 次 右 击 鼠标 ， 在 弹出 的 
快捷 菜单 中 依次 选择 【对 齐 】|【 左 对 齐 】 命 令 。 最 后 在 VBE 开发 环境 中 依次 选择 【格式 】| 
【垂直 间距 】| 【相同 】 命 令 。 

(8) 在 工具 箱 中 选择 框架 控件 并 在 窗 体 中 插入 一 框架 控件 。 在 属性 窗口 中 将 该 框架 控件 
的 Caption 属性 设置 为 “提示 : ”。 然 后 在 工具 箱 中 选择 标签 控件 并 在 刚 插 入 框架 控件 中 创建 
一 标签 控件 。 随 后 在 属性 窗口 中 将 该 控件 的 名 称 属 性 设置 为 labShowMsg， 该 标签 将 用 于 显示 
提示 消息 。 


9.5.2 ”窗口 初始 化 、 激 活 与 卸载 代码 设计 


本 窗 体 的 过 程 很 多 ， 接 下 来 的 几 个 小 节 没有 对 各 个 过 程 逐一 介绍 ， 而 是 将 同类 型 过 程 放 
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置 在 一 起 集中 介绍 。 本 小 节 讲 述 窗口 初始 化 、 激 活 与 卸载 代码 。 
在 窗口 首次 被 打开 时 ， 需 要 完成 初始 化 工作 ， 这 些 工作 包括 设置 公共 变量 以 及 控件 的 显 
示 状 态 及 显示 内 容 。 窗 口中 商场 名 称 复合 框 和 品牌 名 称 复合 框 包含 的 内 容 将 在 窗口 被 激活 事 
件 中 完成 。 将 该 部 分 代码 放置 在 窗口 被 激活 事件 中 ， 可 以 保证 复合 框 列表 内 容 在 程序 运行 中 
能 及 时 反映 用 户 更 新 后 的 数据 。 钊 载 该 窗 体 时 ， 需 要 重 置 部 分 变量 。 以 下 代码 分 别 是 窗口 初 
始 化 、 激 活 与 和 卸载 的 代码 : 

Private Sub UserForm_lnitialize() 

建立 到 基本 信息 数据 库 的 链接 

Set db = OpenDataBase(ThisWorkbook.Path & "\DB\Info.mdb") 

labShowMsg.Caption = "窗口 刚 被 初始 化 ! " "显示 提示 信息 

btnDelete.Enabled = isEditRecord "设置 删除 按钮 的 显示 状态 

"确定 当前 是 输入 销售 数据 还 是 编辑 销售 数据 

IfisEditRecord Then 


Me.Caption = "编辑 " & arrEdited(7) & "号 记录 " "窗口 的 标题 

txtCount.Text = arrEdited(4) "确定 数量 文本 框 数据 

txtPrice .Text = arrEdited(5) "确定 单价 文本 框 数据 
Else 

Me.Caption = "数据 输入 窗 体 " 
End If 
End Sub 
Private Sub UserForm_Activate() ' 窗 体 激活 时 ， 设 置 商 场 与 品牌 列表 框 
SetMarketList "设置 商场 名 称 复合 框 列 表 内 容 
ResetMarkList "设置 品牌 名 称 复合 框 列 表 内 容 
End Sub 
Private Sub UserForm_Terminate() ' 窗 体 卸 载 时 ， 清 空 数据 库 对 象 


Set db = Nothing 

IfisEditRecord Then 
isEditRecord = False 

End 上 

End Sub 


代码 说 明 : 
在 初始 化 过 程 中 ， 当 确认 是 编辑 销售 数据 时 ， 代 码 只 设置 了 【数量 】 文 本 框 和 【单价 】 
文本 框 的 数据 ， 其 他 各 个 复合 框 的 数据 都 在 窗口 被 激活 事件 中 被 设置 。 


9.5.3 ”复合 框 与 文本 框 改变 事件 代码 设计 


用 户 在 使 用 本 窗 体 时 ， 会 根据 需要 选择 适当 的 商场 名 称 、 品 牌 名 称 以 及 产品 型 号 ， 这 些 
数据 都 是 相互 影响 的 。 所 有 的 电器 品牌 在 各 个 商场 都 是 存在 的 。 一 个 品牌 名 称 下 面 有 多 个 产 
品 型 号 ， 不 同 品牌 的 产品 型 号 不 同 。 用 户 在 品牌 复合 框 中 的 选择 不 同 ， 在 产品 型 号 复合 框 中 
显示 的 列表 内 容 也 是 不 同 的 。 下 面 是 这 些 复合 框 与 文本 框 改 变 事件 的 代码 : 
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Private Sub combMark_Change() 
' 当 品牌 列表 框 值 改变 时 ， 如 果 该 值 非 空 ， 刷 新 产品 型 号 与 尺寸 列表 框 
IfLen(combMarket. Text) > 0 Then 
ResetProductList 
End 上 f 
End Sub 


Private Sub combProduct_Change() 

当 产 品 型 号 复合 框 列表 值 改变 时 ， 刷 新 产品 尺寸 文本 框 的 值 
txtSize_Change 

End Sub 


Private Sub txtSize_Change() 


Dim strcomProduct As String 
strcomProduct = combProduct. Text "获取 当前 产品 型 号 
If Len(strcomProduct) = 0 Then Exit Sub ' 未 输入 产品 型 号 时 退出 
以 下 代码 从 产品 型 号 中 获取 产品 尺寸 
i=1 
Do Until i = Len(strcomProduct) "循环 检测 产品 尺寸 字符 串 各 个 字符 
j= Asc(Mid(strcomProduct i, 1)) "获取 第 i 个 字符 的 ASCII 码 
Ifj >= 48 Andj <= 57 Then ' 检 测 第 i 个 字符 是 否 为 数字 
k = Asc(Mid(strcomProduct, i + 1, 1)) "获取 第 i+1 个 字符 的 ASCII 码 
Ifk >= 48 And k <= 57 Then ' 检 测 第 i+1 个 字符 是 否 为 数字 
txtSize. Text = Mid(strcomProduct, i, 2) ' 设 置 尺寸 文本 框 的 显示 值 
Exit Do 
End If 
End If 
i=i+1 "循环 变量 加 1 
Loop 
End Sub 
代码 说 明 : 


口 ”由 于 所 有 商场 都 有 相应 的 品牌 ， 商 场 名 称 复合 框 的 改变 并 不 会 引起 其 他 复合 框 改变 。 
在 代码 中 不 用 设计 商场 复合 框 的 改变 事件 代码 。 

口 “ 当 产品 型 号 复合 框 发 生 改变 时 ， 需 要 刷新 产品 尺寸 文本 框 。 程 序 中 将 这 段 代 码 写 入 
了 产品 尺寸 文本 框 改变 事件 中 ， 这 样 同 时 也 防止 用 户 自己 手动 输入 产品 尺寸 ， 无 论 
用 户 输入 什么 ， 程 序 都 根据 产品 型 号 自动 重新 产生 产品 尺寸。 


9.5.4 按钮 单 击 事 件 代码 设计 


在 该 窗 体 中 包含 了 3 个 功能 按钮 ， 分 别 是 【确定 】、【 删 除 】 和 【关闭 】 按 钮 。【 确 定 】 
按钮 用 于 确认 输入 的 商品 销售 信息 或 修改 信息 ，【 删 除 】 按 钮 只 有 在 对 销售 记录 进行 编辑 时 
可 以 用 ，【 关 闭 】 按 钮 用 于 退出 该 窗 体 。 下 面 依次 介绍 这 3 个 按钮 的 代码 。 

【确定 】 按 钮 较 其 他 两 个 按钮 的 代码 要 复杂 ， 它 需要 根据 具体 情况 完成 相应 的 操作 。 如 
图 9-29 所 示 的 是 该 按钮 单 击 事件 执行 流程 图 。 
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写 入 基本 信息 
新 建 或 修改 销售 资料 


图 9-29 【确定 】 按 钮 单 击 事件 程序 执行 流程 图 


Private Sub btnOK_Click() 
Static intClickCount As Integer, rs As DAO.Recordset 
Dim isResetMarketList As Boolean, isResetMarkList As Boolean, isResetProductList As Boolean 
Dim isToDB As Boolean 
"确定 窗口 输入 数据 是 否 写 入 数据 库 
isToDB = False 
IfisEditRecord Then 
' 当 编辑 记录 时 ， 将 原 数 据 与 新 数据 逐个 比较 ， 不 一 致 时 表示 用 户 做 出 了 修改 ， 需 要 写 入 数据 库 
If combMarket. Text <> arrEdited(0) Then "商场 名 称 是 否 被 修改 
isToDB = True 
GoTo Sub_ Next 
End If 
If combMark.Text <> arrEdited(1) Then "品牌 名 称 是 否 被 修改 
isToDB = True 
GoTo Sub_Next 
End If 
If combProduct. Text <> arrEdited(2) Then "产品 型 号 是 否 被 修改 
isToDB = True 
GoTo Sub_Next 
End If 
If txtSize.Text <> arrEdited(3) Then 产品 尺寸 是 否 被 修改 
isToDB = True 
GoTo Sub_ Next 
End 上 f 
IftxtCount.Text <> arrEdited(4) Then 数量 是 否 被 修改 
isToDB = True 
GoTo Sub_Next 
End 上 f 
If txtPrice.Text <> arrEdited(5) Then 单价 是 否 被 修改 
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isToDB = True 
GoTo Sub_Next 
End 上 
Else 
isToDB = True "输入 销售 数据 时 ， 直 接 将 数据 写 入 数据 库 
End 上 f 
Sub_Next: 
' 检 查 是 否 有 项 目 为 空 的 情况 ， 所 有 项 目 非 空 时 写 入 数据 库 
If (Len(Trim(combMarket. Text)) > 0) And (Len(Trim(combMark. Text)) > 0) And 
(Len(Trim(combProduct.Text)) > 0) And _ 
(Len(Trim(txtSize. Text)) > 0) And (Len(Trim(txtCount. Text)) > 0) And (Len(Trim(txtPrice.Text)) > 0) 
Then 
IfisToDB Then 
"以 下 代码 分 别 检测 商场 名 称 、 品 牌 以 及 产品 型 号 在 数据 库 中 是 否 存在 
' 检 测 商品 名 称 在 数据 库 中 是 否 存在 
Set rs = db.OpenRecordset("select * from t_Marketlnfo where MarketName=" & 
combMarket.Text & "") 
If rs.RecordCount = 0 Then 
i = MsgBox(" 该 买 场 没有 列 入 数据 库 ， 你 现在 需要 将 它 记 录 在 数据 库 里 吗 ? " vbOKCancel 
+ vblnformation) 


fi= vbOKThen ' 将 新 商场 名 称 写 入 数据 库 中 
rs.AddNew 
rs.Fields("MarketName") = combMarket. Text 
rs.Update 
isResetMarketList = True  “”' 标 识 商 场 名 称 复 合 框 需要 刷新 
End If 
End If 
' 检 测 品牌 名 称 在 数据 库 中 是 否 存 在 
Set rs = db.OpenRecordset("select MarkName from t_ Marklnfo where Mark Name=" 
combMark.Text & "") 


Ifrs.RecordCount = 0 Then 
i= MsgBox(" 该 品牌 没有 列 入 数据 库 , 你 现在 需要 将 它 记录 在 数据 库 里 吗 ?", vbOKCancel 
+ vblnformation) 


Ifi= vbOK Then ' 将 新 品牌 名 称 写 入 数据 库 中 
rs.AddNew 
rs.Fields("MarkName") = combMark. Text 
rs.Update 
isResetMarkList = True "标识 品牌 复合 框 需要 刷新 
End If 
End If 


' 检 测 当 前 品牌 下 的 产品 型 号 在 数据 库 中 是 否 存在 
Set rs = db.OpenRecordset("select * from t_Productinfo where Mark=" & combMark. Text & " 
and Product=" & combProduct. Text & "") 

lfrs.RecordCount = 0 Then 

i= MsgBox(" 该 品牌 下 对 应 型 号 在 数据 库 中 没有 记录 ， 你 现在 需要 将 它 记 录 在 数据 库 里 

吗 ? ",vbOKCancel + vblnformation) 
fi=vbOKThen 
With rs ' 将 当前 品牌 下 新 产品 型 号 写 入 数据 库 
.AddNew 
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.Fields("Mark") = combMark.Text 
.Fields("Product") = combProduct. Text 
.Fields("Size") = "S" & txtSize.Text 
.Update 
End With 
isResetProductList = True 标识 产品 型 号 复合 框 需要 刷新 
End If 
End If 
"修改 商品 销售 资料 表 中 的 数据 
IfisEditRecord Then 
RefreshDB 2, combMarket. Text, combMark. Text, combProduct Text, txtSize. Text, 
txtCount. Text, txtPrice. Text 
Else 
RefreshDB 1, combMarket. Text, combMark. Text, combProduct. Text, txtSize. Text, 
txtCount. Text, txtPrice. Text 
End If 
intClickCount = intClickCount + 1 "累计 单 击 确定 按钮 的 次 数 
labShowMsg.Caption = "记录 输入 成 功 ， 你 已 经 输入 了 " & intClickCount & "条 记录 ! " 
IfisEditRecord Then 
isNeedUpdate = True ' 编 辑 记录 时 ， 标 识 ListView 控件 项 目 需要 刷新 
End If 
End If 
Else 
labShowMsg.Caption = "所 输入 的 信息 不 能 为 空 ! 如 果 你 未 发 现 ， 可 能 是 你 输入 了 空格 ， 请 删除 空格 ! " 
MsgBox "请 检查 输入 的 信息 ! 信息 条 目 不 能 为 空 ! " vbOKOnly + vblnformation, "存在 空 条 目 " 
End If 
' 刷 新 各 个 复合 框 
IfisResetMarketList Then SetMarketList 
lfisResetMarkList Then ResetMarkList 
IfisResetProductList Then ResetMarkList 
在 编辑 记录 时 ， 单 击 确定 按钮 后 即刻 退出 窗口 ， 回 到 原 查询 结果 窗口 中 
IfisEditRecord Then 
Unload Me 
End If 
End Sub 


代码 说 明 : 

口 在 单 击 【 确 定 】 按 钮 后 ， 需 要 检测 各 个 项 目 是 否 都 输入 了 数据 ， 当 存在 空 项 目 时 ， 
提示 用 户 输入 数据 。 

口 ”确认 是 否 需要 写 入 数据 库 中 ,检测 工作 较 复杂 .在 程序 中 是 通过 一 个 布尔 变量 isToDB 
来 标识 的 ， 该 布尔 变量 的 值 在 过 程 最 前 面 获得 。 对 于 输入 商品 销售 数据 的 情况 ， 该 
变量 被 直接 设置 为 True。 当 对 销售 数据 进行 编辑 时 ， 程 序 依次 检测 各 个 项 目的 数据 
是 否 发 生变 化 ， 只 要 有 一 项 被 修改 ， 则 将 该 标识 设置 为 True。 

口 “无 论 是 输入 销售 数据 还 是 编辑 销售 数据 ， 都 要 检测 当前 的 基本 信息 数据 是 否 在 基本 
信息 表 中 建立 。 程 序 中 对 商场 名 称 、 品 牌 名 称 及 产品 型 号 逐个 进行 检测 。 当 在 数据 
库 中 没有 对 应 记录 时 ， 程 序 不 强制 将 这 些 数 据 写 入 基本 信息 资料 中 ， 而 是 通过 提示 


办 公 应 用 意 党 之 稍 


Excel VBA 应 用 开发 经 典 案例 


的 方式 。 
口 ” 新 建 或 修改 销售 表 资 料 是 通过 一 个 公用 过 程 来 完成 的 ， 即 RefreshDB， 该 过 程 在 前 面 
已 经 介绍 过 。 这 里 对 于 不 同情 况 ， 该 过 程 被 赋予 了 不 同 的 参数 。 
【删除 】 按 钮 和 【关闭 】 按 钮 的 代码 都 十 分 简单 。 以 下 列 出 两 按钮 的 代码 ， 不 再 加 以 详 
细 说 明 。 
Private Sub btnDelete_Click() 
RefreshDB 3 


Unload Me 
End Sub 


Private Sub btnCancle_Click() 
Unload Me 
End Sub 


9.5.5 ”刷新 复合 框 过 程 代 码 设计 


在 窗口 中 ， 商 场 名 称 列表 、 品 牌 名 称 列表 以 及 产品 型 号 列表 都 有 可 能 需要 在 窗口 开启 过 
程 中 被 更 新 。 当 用 户 输入 了 新 的 商场 名 称 、 品 牌 名 称 以 及 产品 型 号 并 确认 建立 该 基本 信息 后 ， 
都 需要 执行 这 些 过 程 。 这 些 过 程 运行 方式 大 致 一 样 ， 首 先 从 数据 库 中 获取 对 应 的 记录 集 ， 然 
后 将 这 些 记 录 依 次 添加 进 复合 框 中 。 如 图 9-30 所 示 的 是 这 些 过 程 运行 的 流程 图 。 


打开 对 应 记录 集 
清空 复合 框 项 目 


图 9-30 刷新 复合 框 项 目 流程 图 


Private Sub SetMarketList() "刷新 商场 名 称 复合 框 

Dim rs As DAO.Recordset 

"从 商场 名 称 资料 表 中 获取 商场 名 称 记录 集 

Set rs = db.OpenRecordset("select MarketName from t_Marketlnfo order by MarketName", 
dbOpenSnapshot, dbReadOnly, dbReadOnly) 

With combMarket 


.Clear "清空 复合 框 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
lfisEditRecord Then 
.Value = arrEdited(0) "编辑 完 记录 ， 设 置 复合 框 的 值 为 编辑 值 


Else 
.Value = rs.Fields("MarketName") 
End If 
Do Until rs.EOF 
.Addltem rs.Fields("MarketName") 
rs.MoveNext 
Loop 
End 上 f 
End With 
Set rs = Nothing 
End Sub 


Private Sub ResetMarkList() 
Dim rs As DAO.Recordset 
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新 建 完 记录 ， 重 置 复合 框 的 值 为 第 一 个 记录 值 


为 复合 框 添加 项 目 
将 记录 集 指针 向 下 移动 


' 刷 新 品牌 名 称 复合 框 


Set rs = db.OpenRecordset("select MarkName from t_MarkInfo order by MarkName", 


dbOpenSnapshot, dbReadOnly, dbReadOnly) 
With combMark 
.Clear 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
IfisEditRecord Then 
.Value = arrEdited(1) 
Else 
.Value = rs.Fields("MarkName") 
End If 
Do Until rs.EOF 
.Addltem rs.Fields("MarkName") 
rs.MoveNext 
Loop 
End 上 f 
End With 
Set rs = Nothing 
End Sub 


Private Sub ResetProductList() 
Dim rs As DAO.Recordset 
If Len(combMark. Text) = 0 Then Exit Sub 


"依据 所 提供 商场 列表 产品 型 号 列表 与 尺寸 


Set rs = db.OpenRecordset("select Product from t_Productlnfo where Mark=" & combMark.Text & " 
group by Product", dbOpenSnapshot, dbReadOnly, dbReadOnly) 


combProduct.Clear 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
lfisEditRecord Then 
combProduct.Value = arrEdited(2) 
Else 


combProduct.Value = rs.Fields("Product") 


End If 
Do Until rs.EOF 


combProduct.Addltem rs.Fields("Product") 


办 公 应 用 匡 伦 之 稍 


Excel VBA 应 用 开发 经 典 案例 


rs.MoveNext 
Loop 

End If 

Set rs = Nothing 

End Sub 

代码 说 明 : 

口 对 于 不 同 的 复合 框 ， 在 过 程 中 打开 的 记录 集 是 不 同 的。 商场 名 称 记 录 集 可 以 直接 从 
商场 名 称 资料 中 获取 ， 品 牌 名 称 也 可 以 从 品牌 名 称 表 中 直接 获取 ， 但 是 产品 型 号 不 
需要 从 商品 资料 表 中 获取 对 应 品牌 的 产品 型 号 。 

口 刷新 复合 框 时 ， 需 要 设置 复合 框 的 值 。 在 程序 中 ， 对 于 输入 商品 销售 数据 的 情况 ， 
复合 框 的 值 将 被 设置 为 记录 集 的 第 一 个 记录 值 。 对 于 编辑 商品 销售 数据 的 情况 ， 复 
合 框 的 值 将 被 设置 为 编辑 后 得 到 的 新 记录 数据 。 


9.6 查询 销售 数据 设置 窗 体 设计 
查询 销售 数据 设置 窗 体 用 于 设置 销售 查询 条 件 。 在 该 窗 体 中 首先 需要 设置 各 个 单项 的 查 
询 条 件 ， 最 终 的 查询 条 件 是 程序 自动 生成 的 。 在 设置 了 查询 条 件 后 ， 还 可 以 再 重新 修改 查询 
条 件 。 修 改 查 询 条 件 也 是 通过 修改 单项 查询 条 件 实现 的 。 
窗 体 界面 设计 
在 窗 体 中 需要 设置 的 查询 条 件 比 较 多 。 相 比 销售 数据 输入 窗 体 而 言 ， 该 查询 窗 体 还 添加 


了 一 个 时 间 查 询 条 件 。 通 过 该 日 期 查询 条 件 ， 用 户 可 以 获得 固定 销售 日 期 内 的 销售 数据 ， 该 
窗 体 的 界面 如 图 9-31 所 示 。 


图 9-31 查询 销售 数据 设置 窗 体 界面 


对 于 各 个 单项 ， 用 户 可 能 也 需要 添加 多 个 查询 条 件 。 对 于 这 种 情况 ， 在 窗 体 中 设置 了 各 
个 单项 查询 条 件 的 添加 按钮 。 对 于 不 同 条 件 ， 只 需要 单 击 【 添 加 】 按 钮 即 可 获得 多 个 条 件 。 
表 9-3 列 出 了 在 该 窗 体 中 使 用 到 的 部 分 控件 的 名 称 、 控 件 类 型 和 功能 说 明 。 


Ah 
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表 9-3 ”销售 数据 查询 设置 窗 体 控件 列表 


控件 名 称 | 控件 类 型 功能 说 明 
combMarket 复合 该 控件 列 出 了 所 有 在 数据 库 中 已 建立 的 商场 名 称 信息 
combMark 复合 框 | 该 控件 列 出 了 所 有 在 数据 库 中 已 建立 的 品牌 信息 
combProduct 复合 该 控件 列 出 了 所 有 在 数据 库 中 已 建立 的 产品 型 号 信息 


文本 框 。 | 这 控件 用 于 设置 吾 询 商品 尺寸， 当 产 品 型 号 被 确定 时 ， 该 文本 框 显示 的 尺 
SS 寸 是 对 应 该 产品 型 号 的 尺寸 。 用 户 不 能 对 该 尺寸 进行 修改 


该 控件 页 数量 查询 运 一共 me Ry Py yy 
combCompareCount | 复合 框 eh helenat ee 


运算 方式 

txtCount 文本 框 ”| 该 控件 设置 查询 数量 的 比较 数值 

combComparePrice | 复合 杠 该 让 什 列 出 本 所 各 中 价 查询 运 开 方式 ， 一 共 包括 了 =、<、>、<=、>=5 种 
运算 方式 

txtPrice 文本 框 ”| 该 控件 设置 查询 单价 的 比较 数值 

combCompareDate | 复合 杠 这 这 什 列 册 本 所 全 日期 各 网 运 各 方式 - 共 包 括 了 =、<、>、<=、>=5 种 
运算 方式 

combDate 复合 框 该 控件 列 出 了 当月 所 有 日 期 号 

btnFilterString 按钮 该 按钮 打开 总 查询 字符 串 查看 、 修 改 窗口 

btnQue 按钮 该 按钮 打开 查询 结果 显示 窗 体 

btnClose 按钮 该 按钮 用 于 关闭 当前 窗口 

opAND 单 选 按钮 | 设置 查询 条 件 的 逻辑 运 算 方 式 为 与 运算 

opOR 单 选 按钮 | 设置 查询 条 件 的 逻辑 运算 方式 为 或 运算 


窗口 中 所 有 的 添加 按钮 和 修改 按钮 都 使 用 了 CommandButton 加 上 数字 作 


CommandButton+N | 按钮 。。 | 为 名 称 。 这 些 按钮 分 别 完成 各 自 查 询 条 件 的 添加 和 修改 工作 


在 窗 体 中 大 量 使 用 了 重复 控件 类 型 的 控件 ， 而 且 这 些 相 同 控件 类 型 的 控件 被 修改 的 属性 
也 是 一 致 的 。 下 面 在 介绍 窗 体 建 立 步骤 时 ， 将 不 对 重复 控件 类 型 的 建立 操作 做 具体 介绍 。 以 
下 是 建立 该 窗 体 的 步骤 : 

(1) 在 Excel2007 的 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 随 后 在 属 
性 窗口 中 将 该 新 插入 窗 体 的 名 称 属性 设置 为 fmQuery， 如 图 9-32 所 示 。 

(2) 在 工具 箱 中 选择 框架 控件 ， 在 新 窗 体 中 单 击 鼠 标 左 键 并 拖 动 以 产生 适当 大 小 的 框 
架 。 随 后 在 属性 窗口 中 设置 该 框架 的 Caption 属性 为 “查询 条 件 输入 区 : ”， 如 图 9-33 所 示 。 


图 9-32 ”查询 设置 窗 体 属性 设置 图 9-33 ”查询 窗 体 设计 效果 示意 图 


6 


5 


(3) 在 工具 箱 中 选择 标签 控件 ， 然 后 在 框架 中 连续 建立 7 个 标签 控件 。 随 后 在 属性 窗口 


中 依次 设置 这 些 标 签 控件 的 Caption 属性 为 “商场 名 称 : ”、“ 品 牌 : ”、“ 产 品 型 号 : ”、 
“尺寸 ”、 “数量 ，”、 “单价 ，” 和 “日 期 ，”。 


(4) 在 工具 箱 中 选择 复合 框 控件 ， 在 框架 中 连续 建立 7 个 复合 框 控 件 。 随 后 在 属性 窗口 


中 依次 设置 这 些 复 合 框 的 名 称 属性 为 combMarket、combMark、combProduct、combCompare- 
Count、 combComparePrice .combCompareDate 和 combDate。SelectionMargin 属性 都 设置 为 False。 


(5) 在 工具 箱 中 选择 文本 框 控件 ， 在 框架 中 连续 建立 3 个 文本 框 控 件 。 随 后 在 属性 窗口 


中 设置 这 些 文本 框 的 名 称 属 性 分 别 为 txtSize、txtCount 和 txtPrice。SelectionMargin 属性 都 设 
置 为 False。 


(6) 在 工具 箱 中 选择 按钮 控件 ， 在 框架 中 连续 建立 两 个 按钮 控件 。 在 属性 窗口 中 将 这 两 


个 按钮 控件 的 Caption 属性 依次 设置 为 “添加 ”和 “修改 ”。 然 后 将 这 两 个 按钮 控件 分 别 复制 


份 。 随 后 将 这 些 按钮 成 对 放置 在 各 自 对 应 的 标签 控件 右 侧 。 
(7) 在 工具 箱 中 选择 按钮 控件 ， 在 窗 体 的 右 侧 连续 创建 3 个 按钮 控件 。 随 后 在 属性 窗口 
1 设置 这 些 按钮 的 名 称 属性 依次 为 btnFilterString、btnQuery 和 btnClose。Caption 属性 依次 设 


置 为 “查询 字符 串 ”、“ 查 看 查询 集合 ”和 “关闭 ”。 


(8) 在 工具 箱 中 选择 框架 控件 。 随 后 在 步骤 (7) 创建 的 3 个 按钮 控件 的 下 方 ， 新 建 一 


个 框架 控件 。 然 后 在 属性 窗口 中 将 该 控件 的 Caption 属性 设置 为 “运算 方式 : ”。 


(9) 在 工具 箱 中 选择 单 选 框 控件 。 随 后 在 步骤 (8) 创建 的 框架 控件 中 连续 创建 两 个 单 


选 按钮 。 在 属性 窗口 中 设置 这 两 个 单 选 按钮 控件 的 名 称 属性 为 opAND 和 opOR，Caption 属性 
依次 设置 为 “与 运算 ”和 “或 运算 ”。 


Private Sub btnClose_Click() 


Unload Me 

End Sub 

Private Sub btnFilterString_Click() "准备 信息 ， 然 后 显示 总 筛选 条 件 
SetSQL 

intFilterlIndex = 8 

frmFilterEdit.Show 

End Sub 

Private Sub btnQuery_Click() "准备 信息 ， 然 后 显示 筛选 结果 窗 体 
SetSQL 

Me.Hide 

frmQryResult.Show 

End Sub 

Private Sub combMark_Change() ' 当 品牌 列表 变化 时 ， 刷 新 产品 型 号 与 尺寸 列表 
ResetProcutList 

End Sub 


Private Sub combProduct_Change() 
Dim strcomProduct As String 
strcomProduct = combProduct.Text 
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If Len(strcomProduct) = 0 Then Exit Sub 
i=1 
Do Until i = Len(strcomProduct) 
j= Asc(Mid(strcomProduct, i, 1)) 
Ifj >= 48 And j <= 57 Then 
k= Asc(Mid(strcomProduct, i + 1, 1)) 
Ifk >= 48 And k <= 57 Then 
txtSize. Text = Mid(strcomProduct i, 2) 
Exit Do 
End If 
End If 
i=i+1 
Loop 
End Sub 


Private Sub txtSize_Change() 
Dim strcomProduct As String 
strcomProduct = combProduct.Text 
If Len(strcomProduct) = 0 Then Exit Sub 
i=1 
Do Until i = Len(strcomProduct) 
j= Asc(Mid(strcomProduct, i, 1)) 
Ifj >= 48 Andj <= 57 Then 
k= Asc(Mid(strcomProduct, i + 1, 1)) 
Ifk >= 48 And k <= 57 Then 
txtSize. Text = Mid(strcomProduct i, 2) 
Exit Do 
End If 
End If 
i=i+1 
Loop 
End Sub 


Private Sub CommandButton1_Click() 
intFilterIndex = 2 

AddFilter 2 

End Sub 


Private Sub CommandButton10_Click() 
intFilterIndex = 6 

AddFilter 6 

End Sub 


Private Sub CommandButton11_Click() 
intFilterIndex = 7 

AddFitter 7 

End Sub 


Private Sub CommandButton12_Click() 


™ 
商场 销售 效 所 入 加 系统 和 洲 


intFilterlndex =7 
frmFilterEdit.Show 
End Sub 


Private Sub CommandButton2_ Click() 


intFilterIndex = 2 
frmFilterEdit.Show 
End Sub 


Private Sub CommandButton3_Click() 


intFilterlIndex = 3 
AddFitter 3 
End Sub 


Private Sub CommandButton4_Click() 


intFilterlIndex = 3 
frmFilterEdit.Show 
End Sub 


Private Sub CommandButton5_Click() 


intFilterindex = 4 
frmFilterEdit.Show 
End Sub 


Private Sub CommandButton6_Click() 


intFilterlndex = 4 
AddFitter 4 
End Sub 


Private Sub CommandButton7_Click() 


intFilterlndex = 5 
frmFilterEdit.Show 
End Sub 


Private Sub CommandButton8_Click() 


intFilterlIndex = 5 
AddFitter 5 
End Sub 


Private Sub CommandButton9_Click() 


intFilterlIndex = 6 
frmFilterEdit.Show 
End Sub 


Private Sub CommandButton13_Click() 


intFilterIndex = 1 
AddFitter 1 
End Sub 


办 公 应 用 意 党 之 狗 
Excel VBA 应 用 开发 经 典 案例 


单 击 添加 单项 筛选 条 件 时 ， 设 置 准备 信息 
决定 是 对 哪个 单项 进行 了 设置 筛选 条 件 操作 
合并 该 单项 下 的 筛选 条 件 
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Private Sub CommandButton14_Click() ' 显 示 编辑 单项 筛选 条 件 窗 体 ， 设 置 准备 信息 
intFilterIndex = 1 
frmFilterEdit.Show 


End Sub 

Private Sub UserForm_lnitialize() ' 初 始 化 窗 体 
Dim arrCompare As Variant 

SetMarketList 

ResetMarkList 

ResetProcutList 

arrCompare = Array("=", "<", ">", "<=", ">=") 
combCompareCount.Clear 


combComparePrice.Clear 
combCompareDate.Clear 
Fori=0To4 
combCompareCount.Addltem arrCompare(i) 
combComparePrice.Addltem arrCompare(i) 
combCompareDate.Addltem arrCompare(i) 
Next 
combCompareCount.Text = "=" 
combComparePrice. Text 
combCompareDate.Text = 
combDate.Clear 
Fori=1To31 
combDate.Addltem i 
Next 
opOR.Value = True 
End Sub 


Private Sub SetMarketList() ' 刷 新 商场 列表 
Dim rs As DAO.Recordset 
Set db = OpenDataBase(ThisWorkbook.Path & "DB\Info.mdb") 
Set rs = db.OpenRecordset("select MarketName from t_Marketlnfo order by MarketName", 
dbOpenSnapshot, dbReadOnly, dbReadOnly) 
With combMarket 
.Clear 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
Do Until rs.EOF 
.Addltem rs.Fields("MarketName") 
rs.MoveNext 
Loop 
End If 
End With 
Set rs = Nothing 
End Sub 


Private Sub ResetMarkList() "依据 所 提供 商场 列表 产品 型 号 列表 
Dim rs As DAO.Recordset 


办 公 应 用 非常 之 狗 
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Set db = OpenDataBase(ThisWorkbook.Path & "\DB\Info.mdb") 
Set rs = db.OpenRecordset("select MarkName from t_Marklnfo order by MarkName", 
dbOpenSnapshot, dbReadOnly, dbReadOnly) 
With combMark 
.Clear 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
Do Until rs.EOF 
.Addltem rs.Fields("MarkName") 
rs.MoveNext 
Loop 
End If 
End With 
Set rs = Nothing 
End Sub 


Private Sub ResetProcutList() "依据 所 提供 商场 列表 产品 型 号 列表 
Dim rs As DAO.Recordset 
IfLen(combMark.Text) = 0 Then Exit Sub 
Set db = OpenDataBase(ThisWorkbook.Path & "\DB\Info.mdb") 
Set rs = db.OpenRecordset("select Product from t_Productlnfo where Mark=" & combMark.Text & ” 
Group by Product", dbOpenSnapshot, dbReadOnly, dbReadOnly) 
combProduct.Clear 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
Do Until rs.EOF 
combProduct.Addltem rs.Fields("Product") 
rs.MoveNext 
Loop 
End If 
Set rs = Nothing 
End Sub 


Private Sub opAND_Click() ' 设 置 运算 方式 为 AND 
opMethod = True 
End Sub 


Private Sub opOR_Click() ' 设 置 运算 方式 为 OR 
opMethod = False 
End Sub 


Private Sub AddFilter(intIndex As Integer) ' 修 改 单项 筛选 条 件 
Select Case intlndex 
Case 1 
If Len(Trim(combMarket.Text)) > 0 Then 
f Len(strMarketFilter) Then 
IfopMethod Then 
strMarketFilter = strMarketFilter & " and MarketName=" & 

Trim(combMarket. Text) & ™" 
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Else 
strMarketFilter = strMarketFilter & " or MarketName=" & Trim(combMarket. Text) & "™ 
End If 
Else 
strMarketFilter = "MarketName=" & Trim(combMarket.Text) & ™™ 
End If 
End If 
Case2 
If Len(Trim(combProduct. Text)) Then 
If Len(strProductFilter) Then 
lf opMethod Then 
strProductFilter = strProductFilter & " and Product=" & Trim(combProduct.Text) & ™ 
Else 
strProductFilter = strProductFilter & " or Product=" & Trim(combProduct.Text) & "" 
End 上 
Else 
strProductFilter = "Product=" & Trim(combProduct.Text) & ™™ 
End If 
End If 
Case3 
If Len(Trim(txtSize. Text)) Then 
f Len(strSizeFilter) Then 
lf opMethod Then 
strSizeFilter = strSizeFilter & " and Size=" & Trim(txtSize. Text) & "™ 
Else 
strSizeFilter = strSizeFilter & " and Size=" & Trim(txtSize. Text) & "™ 
End If 
Else 
strSizeFilter = "Size=" & Trim(txtSize. Text) & "" 
End If 
End If 
Case 4 
If Len(Trim(txtCount.Text)) > 0 Then 
If Len(strNumberFilter) Then 
If opMethod Then 
strNumberFilter = strNumberFilter & " and Number" & combCompareCount.Text 
& Trim(txtCount. Text) 
Else 
strNumberFilter = strNumberFilter & " or Number" & combCompareCount. Text & 
Trim(txtCount. Text) 
End 上 
Else 
strNumberFilter = "Number" & combCompareCount.Text & Trim(txtCount.Text) 
End If 
End If 
Case5 
If Len(Trim(txtPrice. Text)) Then 
If Len(strPriceFilter) Then 
lf opMethod Then 
strPriceFilter = strPriceFilter & " and Price" & combComparePrice.Text & 


办 公 应 用 齐 党 乞 比 - 
Excel VBA 应 用 开发 经 典 案 例 


Trim(txtPrice. Text) 
Else 
strPriceFilter = strPriceFilter & " or Price" & combComparePrice. Text & 
Trim(txtPrice. Text) 
End If 
Else 
strPriceFilter = "Price" & combComparePrice.Text & Trim(txtPrice. Text) 
End If 
End If 
Case6 
If Len(Trim(combDate. Text)) Then 
f Len(strDateFilter) Then 
If opMethod Then 
strDateFilter = strDateFilter & " and Date" & combCompareDate. Text & 
Trim(combDate.Text) 
Else 
strDateFilter = strDateFilter & " or Date" & combCompareDate. Text & 
Trim(combDate. Text) 
End If 
Else 
strDateFilter = "Date" & combCompareDate.Text & Trim(combDate.Text) 
End If 
End If 
Case7 
IfLen(Trim(combMark.Text)) Then 
f Len(strMarkFilter) Then 
lfopMethod Then 
strMarkFilter = strMarkFilter & " and Mark=" & Trim(combMark.Text) & "™ 
Else 
strMarkFilter = strMarkFilter & " or Mark=" & Trim(combMark.Text) & "™ 
End If 
Else 
strMarkFilter = "Mark=" & Trim(combMark. Text) & ™" 
End If 
End If 
End Select 
End Sub 


Private Sub UserForm_Terminate() ' 窗 体 和 卸载 持 ， 清 空 各 个 变量 
strMarketFilter = "" 
strProductFilter = 
strSizeFilter =" 
strNumberFilter = ™ 
strPriceFilter = 
strDateFilter = 
strMarkFilter = "" 
Set db = Nothing 
End Sub 
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查询 显示 与 分 析 窗 体 用 于 显示 满足 查询 设置 窗 体 中 设置 条 件 的 记录 集 。 窗 体 通 过 一 个 
ListView 控件 显示 了 所 有 满足 条 件 的 记录 。 在 该 窗 体 中 用 户 可 以 继续 对 销售 记录 进行 编辑 , 还 
可 以 将 这 些 记录 导出 到 新 的 Excel 表 中 , 也 可 以 在 该 查询 结果 中 再 次 手动 进行 筛选 并 且 导 出 得 
选 后 的 结果 。 


9.7.1 窗 体 界 面 设 计 


查询 结果 显示 窗 体 包 含 了 一 个 ListView 控件 用 于 显示 查询 结果 。 窗 体 还 包含 了 5 个 功能 
按钮 ， 这 5 个 功能 按钮 分 别 是 导出 所 有 项 、 重 置 、 仅 显示 勾 选 项 、 编 辑 和 关闭 。 如 图 9-34 所 
示 的 是 该 窗 体 的 界面 。 
口 ”导出 所 有 项 :该 按钮 将 把 ListView 控件 中 显示 的 所 有 记录 项 目 导出 到 一 个 新 Excel 
工作 短 中 。 当 用 户 通过 手动 选择 项 目 后 ， 单 击 【 仪 显示 勾 选 项 】 按 钮 后 ，【 导 出 所 
有 项 】 按 钮 导出 的 数据 是 选中 后 显示 出 来 的 所 有 数据 。 
口 重 置 ; 该 按钮 只 有 在 单 击 【 仅 显 示 勾 选项 按钮 后 才 被 激活 。 该 按钮 被 单 击 后 , ListView 
控件 的 显示 记录 将 被 恢复 到 初始 查询 结 
仅 显 示 勾 选项 ， 该 按钮 把 ListView 中 被 选中 的 项 目 单独 列 出 显示 在 ListView 控件 中 。 
编辑 : 该 按钮 将 打开 记录 编辑 窗口 ， 它 相当 于 在 项 目 上 双击 的 效果 。 
关闭 : 该 按钮 将 关闭 查询 显示 结果 窗 体 。 


DO 


sii 项 | | 页 | 名 | zn | 


图 9-34 查询 显示 窗 体 界面 


窗 体 的 界面 布局 十 分 简单 ， 需 要 注意 的 是 当 ListView 控件 在 工具 箱 中 无 法 找到 时 ， 需 要 
引用 Microsfot Windows Common Controls 6.0(SP6)。 在 前 面 章节 已 经 接触 到 该 方面 的 内 容 ， 具 
体操 作 方法 请 见 相应 章节 的 介绍 。 


9.7.2 窗 体 事件 代码 设计 


在 该 窗 体 中 ， 有 关 窗 体 的 事件 包括 窗 体 的 初始 化 以 及 
窗 体 卸 载 事件 。 窗 口 初始 化 事件 除了 将 查询 到 的 记录 集 显 
直至 | Tj 办 件 上 ， 还 雪 要 设 署 各 个 核 鱼 散 
示 到 ListView 控件 上 ， 还 需要 设置 各 个 按钮 的 可 用 状态 。 
窗 体 和 抒 载 时 ， 需 要 删除 临时 表 、 清 除 部 分 变量 占用 内 存 空 
间 以 及 恢复 查询 设置 窗 体 显示 。 初 始 化 的 代码 比较 多 ， 下 
面 着 重 讲述 该 部 分 代码 。 如 图 9-35 所 示 的 是 该 初始 化 事件 图 9-35 查询 结果 显示 窗 体 初始 化 
过 程 的 流程 图 。 事件 代码 执行 流程 图 
Private Sub UserForm_lnitialize() ' 窗 体 初始 化 时 ， 建 立 数据 库 对 象 与 记录 集 对 象 
Dim qryString As String 
Dim itemList As Listltem, rsCount As Long 
链接 数据 库 
Set db = OpenDataBase(ThisWorkbook.Path & \DB\db.mdb") 
' 打 开 记 录 集 
If Len(strSQL) > 0 Then "确定 查询 记录 集 的 SQL 语句 
qryString = "select * from t_Sale where " & strSQL 
Else 
qryString = "select * from t_Sale" 
End If 
以 快照 、 只 读 形 式 打开 记 录 集 
Set rs = db.OpenRecordset(qryString, dbOpenSnapshot, dbReadOnly, dbReadOnly) 
isSaveAll = True 
' 刷 新 ListView 控件 列 头 
refreshListHeader 
' 将 记录 集 写 入 ListView 控件 中 
If Not (rs.EOF And rs.BOF) Then 
rs.MoveFirst 
ListViewQry.LabelEdit = IvwManual 单 击 ListView 控件 第 一 列 时 不 变 成 被 编辑 状态 
ListViewQry.HideSelection = False 'ListView 失去 焦点 时 仍然 显示 被 选择 项 
With ListViewQry.Listltems 
.Clear 
Do Until rs.EOF 
Set itemList = .Add(Text:=rs.Fields("MarketName")) 
itemList.Subltems(1) = rs.Fields("Mark") 
itemList.Subltems(2) = rs.Fields("Product") 
itemList.Subltems(3) = rs.Fields("Size") 
itemList.Subltems(4) = rs.Fields("Number") 
itemList.Subltems(5) = rs.Fields("Price") 
itemList.Subltems(6) = rs.Fields("Date") 
itemList.Subltems(7) = rs.Fields("ID") 
rsCount = rsCount + 1 
rs.MoveNext 
Loop 
End With 


打开 记录 集 
刷新 Listview 控 件 列 头 


Ah 
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End If 
'ListView 控件 项 目 将 按照 第 一 列 升序 排列 
With ListViewQry 


.SortKey= 0 
.Sorted = True 
.SortOrder = IlvwwAscending 
End With 
' 在 窗 体 的 标题 栏 显示 提示 信息 
Me.Caption = "查询 结果 -总 共 " & rsCount & "条 记录 " 
' 设 置 按钮 可 用 状态 
btnReset.Enabled = False 
End Sub 
Private Sub UserForm_Terminate() ' 窗 体 卸 载 时 ,清除 数据 库 ， 记 录 集 对 象 ， 删 除 临 时 文件 


On Error Resume Next 

db.Execute ("Drop Table TempTable") 

On Error GoTo 0 

Set rs = Nothing 

Set db = Nothing 

frmQuery.Show 

End Sub 

代码 说 明 : 

口 程序 中 ， 当 没有 设置 查询 条 件 时 ， 默 认 的 是 查询 所 有 记录 。 在 初始 化 过 程 打 开 记 录 
集 时 ， 首 先 使 用 了 下 语句 分 别 确定 了 对 应 的 SQL 查询 语句 ， 以 便 得 出 满足 要 求 的 记 

口 程序 中 的 记录 集 是 以 快照 、 只 读 形式 打开 的 ， 这 种 形式 的 记录 集 不 可 被 修改 。 程 序 
中 只 需要 读 取 记录 集 数 据 ， 使 用 该 种 形式 打开 记录 集 可 以 加 快运 行 速度 。 

口 当 希 望 ListView 控件 显示 结果 按照 某 列 进行 排序 时 ， 首 先 需 要 指定 排序 的 列 索引 
SortKey， 该 值 从 0 开始 计数 ， 然 后 将 Sorted 设置 为 True， 开 启 排序 。 排 序 的 顺序 由 
SortOrder 决定 。 

口 在 初始 化 窗 体 过 程 中 , 调用 了 refreshListHeader 过 程 ， 该 过 程 用 于 刷新 ListView 控件 
的 列 头 。 该 过 程 的 代码 如 下 : 


Private Sub refreshListHeader() "刷新 列表 头 
With ListViewQry 
.Gridlines = True "显示 网 格 线 
.FullRowSelect = True "允许 选中 整 行 
.MultiSelect = True ' 允 许多 行 选择 
.LabelEdit = False ' 不 允许 编辑 标签 控件 
.View = IvwReport "预览 模式 为 lvwReport 
With .ColumnHeaders 
.Clear ' 清 除 列 头 
-Add Text:=" 商 场 名 ", Width:=74 "以 下 分 别 添加 各 列 列 头 


.Add Text:=" 品 牌 ", Width:=39 
.Add Text:=" 产 品 型 号 ", Width:=65 
.Add Text:=" 尺 寸 ", Width:=35 
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.Add Text:=" 数 量 ", Width:=35 
.Add Text:=" 单 价 ", Width:=49 
.Add Text:=" 日 期 ", Width:=30 
.Add Text:="ID", Width:=74 
End With 
End With 
End Sub 


9.7.3 ListView 控件 事件 代码 设计 


窗 体 的 主体 部 分 就 是 ListView 控件 ， 窗 体 中 的 按钮 执行 的 命令 也 是 与 该 ListView 控件 相 
关联 的 。 本 部 分 讲述 的 代码 是 该 控件 的 事件 代码 ， 包 括 列 单 击 事件 、 控 件 双 击 事件 、 项 目 单 
击 事件 。 这 些 事件 都 是 为 了 响应 用 户 的 操作 而 建立 的 。 

列 单 击 事件 可 以 支持 自 定义 排序 。 初 始 化 时 ListView 控件 按照 第 一 列 进行 升序 排列 ， 但 
用 户 可 能 需要 将 记录 按照 其 他 的 列 进行 排序 以 便于 快速 定位 到 需要 查看 的 记录 。ListView 本 身 
不 支持 该 功能 ， 但 通过 列 单 击 事件 可 以 实现 相应 的 功能 。 

ListView 控件 支持 双击 打开 某 项 记录 的 编辑 窗口 ， 但 是 ListView 控件 并 没有 项 目的 双击 
事件 。 程 序 实现 该 功能 的 方式 是 通过 ListView 控件 的 双击 事件 完成 的 。 当 ListView 控件 被 双 
击 时 ， 将 打开 在 控件 中 被 选择 项 目的 编辑 窗口 ， 和 否则 任何 动作 都 不 执行 。 以 下 是 这 些 事件 的 
详细 代码 : 

Private Sub ListViewQry_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) 


' 单 击 列表 头 时 排序 
Static Oldindex As Integer, CountNum As Integer 
Oldindex = ListViewQry.SortKey "记录 原 排 序列 的 索引 号 
ListViewQry.SortKey = ColumnHeader.Index-1 "获取 当前 需 排序 列 的 列 索引 号 
ListViewQry.Sorted = True "开启 排序 
If OldIndex = ListViewQry.SortKey Then "CountNum 记录 在 同一 列 单 击 的 次 数 
CountNum = CountNum + 1 
Else 
CountNum =0 
End If 
If CountNum Mod 2 = 0 Then ' 按 照 单 击 同一 列 的 次 数 确定 排序 的 方式 
ListViewQry.SortOrder = lvwAscending 
Else 
ListViewQry.SortOrder = lvwDescending 
End If 
End Sub 
Private Sub ListViewQry_DblClick() 
If Not ListViewQry.Selectedltem Is Nothing Then 
SetitemEdited = ListViewQry.Selectedltem 将 当前 选择 的 项 目 赋 给 对 象 变量 
btnEdit_Click ' 开 启 销售 记录 编辑 窗 体 
End If 
End Sub 
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9.7.4 导出 所 有 项 按钮 代码 设计 


【导出 所 有 项 按钮 将 把 ListView 控件 中 显示 的 所 有 记录 保存 到 Excel 文件 中 。 如 图 9-36 


获取 保存 文件 位 置 


ET 


图 9-36 【导出 所 有 项 】 按 钮 运行 流程 图 


Private Sub btnToXLS_Click() "导出 所 有 记录 到 Excel 文件 
Dim wk As Workbook, ws As Worksheet, strFileSaveName As String, rsXLS As DAO.Recordset 
"创建 CommonDialog 对 象 
Set objDialog = CreateObject("UserAccounts.CommonDialog") 
objDialog.Filter = "Excel File(*.xls)|*.xls” ”' 设 置 文 件 类 型 
objDialog.Filterindex = 1 ' 首 次 打开 文件 筛选 器 时 ， 上 默认 的 文件 类 型 为 第 一 个 
intResult = objDialog.ShowOpen "打开 文件 筛选 器 
strFileSaveName = objDialog.FileName ”' 将 文件 名 称 保存 在 变量 中 
IfLen(strFileSaveName) > 0 Then 
Set wk = Workbooks.Add ' 建 立新 工作 簿 以 保存 数据 
Application.DisplayAlerts = False 
Do Until wk.Worksheets.Count = 1 ' 删 除 无 用 工作 表 , 只 留 下 一 个 工作 表 且 命名 为 “查询 结果 ” 
wk.Worksheets(1).Delete 
Loop 
Application.DisplayAlerts = True 
Set ws = wk.Worksheets(1) 
ws.Name = "查询 结果 " 
' 当 保存 筛选 后 的 数据 时 ， 从 临时 表 获 取 记 录 集 。 否 则 使 用 原 查 询 记录 集 
If Not isSaveAll Then 
Set db = OpenDataBase(ThisWorkbook.Path & “DB\db.mdb") 
Set rsXLS = db.OpenRecordset("TempTable") 
End If 
rs.MoveFirst 
With ws 
为 数据 表 添 加 列 头 
.Cells(1, 1) = "商场 名 " 
.Cells(1, 2) = "品牌 " 
.Cells(1, 3) = "产品 型 号 " 
.Cells(1, 4) = "尺寸 " 
.Cells(1, 5) = "数量 " 
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.Cells(1, 6) = "单价 " 
.Cells(1, 7) = "日 期 " 
.Cells(1, 8) = "ID" 
If Not isSaveAll Then 
.Range("A2").CopyFromRecordset rsXLS “' 当 保存 筛选 后 的 记录 时 ， 复 制 临时 表 获 取 记 


录 集 的 数据 
Else 
.Range("A2").CopyFromRecordset rs ' 当 保存 查询 结果 记录 时 ， 复 制 原 查 询 记录 集 
的 数据 
End If 
.Columns("A:H").EntireColumn.AutoFit "将 新 表 的 列 自动 对 齐 
End With 
wk.SaveAs strFileSaveName "保存 文件 


wk.Application.Visible = True 
MsgBox "文件 保存 成 功 ! ", vbOKOnly + vblnformation, "保存 " 
End If 
Set ws = Nothing 
Set wk = Nothing 
Set rsXLS = Nothing 
End Sub 


9.7.5 重 置 按钮 代码 设计 


当 用 户 在 ListView 控件 中 选择 了 部 分 记录 项 后 ， 单 击 【 仅 显示 色 选 项】 按钮 后 ，【 重 署 】 
按钮 被 激活 。 该 按钮 用 于 将 ListView 控件 显示 项 目 恢复 到 原来 的 查询 结果 记录 状态 。 代 码 十 
分 简单 ， 它 直接 调用 了 窗 体 的 初始 化 事件 过 程 。 因 为 该 过 程 完成 的 就 是 显示 查询 结果 记录 并 
且 修 改 按钮 显示 状态 。 在 该 按钮 被 单 击 后 ，IsSaveAll 被 设置 为 True， 因 为 此 时 显示 的 是 所 有 
查询 记录 。 

Private Sub btnReset_Click() 

UserForm_Initialize 


isSaveAll = True 
End Sub 


9.7.6 ” 仅 显 示 勾 选项 按钮 代码 设计 


该 按钮 将 把 用 户 在 ListView 控件 中 选择 的 记录 单独 显示 在 ListView 控件 中 。 该 按钮 的 单 
击 事件 首先 检测 是 否 有 记录 被 选中 。 当 有 记录 被 选中 时 ， 程 序 将 把 所 有 已 选中 的 项 目 显示 在 
ListView 控件 中 ， 并 且 将 这 些 记 录 数 据 保 存在 临时 表 中 。 这 部 分 的 工作 是 由 过 程 
ShowSelectedItem 完成 的 。 下 面 是 该 按钮 的 单 击 事件 代码 ， 过 程 ShowSelectedItem 的 详细 代码 
将 在 后 面 详细 介绍 。 

Private Sub btnShowSelected_Click() ' 显 示 被 选中 的 项 目 


Dim isSelectedExist As Boolean 
"检查 是 否 有 项 目 被 选中 
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isSelectedExist = False 
For Each clhListltem In ListViewQry.Listltems 
lf clhListltem.Checked = True Then “' 当 发 现 有 项 目 被 选中 时 ， 标 记 isSelectedExist， 并 退出 


检测 循环 
isSelectedExist = True 
Exit For 
Endif 
Next 
' 显 示 选 中 记录 
IfisSelectedExist Then 
ShowSelectedltem ' 在 ListView 控件 中 显示 被 选中 的 所 有 记录 
btnReset.Enabled = True "设置 重 置 按钮 的 可 用 状态 
isSaveAll = False "此 时 保存 数据 是 对 手动 选中 后 的 数据 ， 而 非 原 查询 数据 
Else 
MsgBox "没有 勾 选 任何 选项 ! " vbOKOnly + vblnformation, "提示 " 
End 上 f 
End Sub 


将 所 有 已 选中 的 记录 项 目 显 示 在 ListView 控件 中 并 将 数据 保存 在 临时 表 的 ShowSelected- 
Item 过 程 。 其 代码 比较 复杂 ， 这 里 加 以 详细 介绍 。 图 9-37 所 示 的 是 该 过 程 的 执行 流程 图 。 


ri 


删除 旧 临 时 表 


生成 新 临时 表 及 结构 


向 临时 表 填 充 数据 
将 数据 写 入 Listview 控 件 


图 9-37 ” 仅 显示 色 选 项 过 程 流程 图 


Private Sub ShowSelectedltem()  ' 在 列表 中 显示 选中 项 目 (保存 选中 项 目 到 临时 文件 ,然后 刷新 列表 ) 
Dim clhListltem As Listltem, isSelectedExist As Boolean 
Dim rsXLS As DAO.Recordset, tdf As DAO.TableDef 
isSelectedExist = False 
' 检 测 是 否 有 记录 被 选中 
For Each clhListltem In ListViewQry.Listltems 
If clhListltem.Checked = True Then 
isSelectedExist = True 
Exit For 
End If 
Next 
' 删 除 旧 临 时 表 并 生成 新 临时 表 
lfisSelectedExist Then 
On Error Resume Next 
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db.Execute ("Drop Table TempTable") 
On Error GoTo 0 
Set db = OpenDataBase(ThisWorkbook.Path & "\DB\db.mdb") 
Set tdf = db.CreateTableDef("TempTable") 
Set fld = tdf.CreateField("MarketName", dbText, 50) 
tdf.Fields.Append fd 
Setfld = tdf.CreateField("Mark", dbText, 50) 
tdf.Fields.Append fd 
Set fld = tdf.CreateField("Product", dbText, 50) 
tdf.Fields.Append fd 
Set fld = tdf.CreateField("Size", dbText, 50) 
tdf.Fields.Append fld 
Set fld = tdf.CreateField("Number", dblntegen) 
tdf.Fields.Append fld 
Set fld = tdf.CreateField("Price", dbDouble) 
tdf.Fields.Append fld 
Set fld = tdf.CreateField("Date", dblntegen) 
tdf.Fields.Append fld 
Set fld = tdf.CreateField("ID", dbText, 14) 
tdf.Fields.Append fld 
db.TableDefs.Append tdf 
Set rsXLS = db.OpenRecordset("TempTable") 
For Each clhListltem In ListViewQry.Listltems 
If clhListltem.Checked = True Then 
rsXLS.AddNew 
rsXLS.Fields("MarketName") = clhListltem. Text 
rsXLS.Fields("Mark") = clhListltem.Subltems(1) 
rsXLS.Fields("Product") = clhListltem.Subltems(2) 
rsXLS.Fields("Size") = clhListltem.Subltems(3) 
rsXLS.Fields("Number") = clhListltem.Subltems(4) 
rsXLS.Fields("Price") = clhListltem.Subltems(5) 
rsXLS.Fields("Date") = clhListltem.Subltems(6) 
rsXLS.Fields("ID") = clhListltem.Subltems(7) 
rsXLS.Update 
i=i+1 
End If 
Next 
' 清 空 ListView 控件 后 将 勾 选 记录 显示 在 ListView 控件 上 
rsXLS.MoveFirst 
With ListViewQry.Listltems 
.Clear 
Do Until rsXLS.EOF 
Set clhListltem = .Add(Text:=rsXLS.Fields("MarketName")) 
clhListltem.Subltems(1) = rsXLS.Fields("Mark") 
clhListltem.Subltems(2) = rsXLS.Fields("Product") 
clhListltem.Subltems(3) = rsXLS.Fields("Size") 
clhListltem.Subltems(4) = rsXLS.Fields("Number") 
clhListltem.Subltems(5) = rsXLS.Fields("Price") 
clhListltem.Subltems(6) = rsXLS.Fields("Date") 
clhListltem.Subltems(7) = rsXLS.Fields("ID") 


链接 数据 库 
' 创 建 临 时 表 及 其 字段 


' 向 临时 表 添加 记录 


_ 
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rsXLS.MoveNext 
Loop 

End With 
End 上 f 
Me.Caption = " 勾 选 后 的 结果 -总 共 " & i & "条 记录 " 
Set rsXLS = Nothing 
Set dbXLS = Nothing 
Set wkJet = Nothing 
End Sub 


9.7.7 ”编辑 按钮 代码 设计 


单 击 【编辑 】 按 钮 时 ， 首 先 需要 获取 记录 的 相关 信息 。 程 序 通过 一 个 arrEdited 数组 保存 
了 选 定 记录 项 的 所 有 数据 。 当 打开 记录 编辑 窗口 后 ， 该 窗口 将 由 此 确定 需要 显示 并 编辑 的 记 
录 。 关 于 编辑 窗 体 如 何 利用 这 个 数组 完成 编辑 操作 的 代码 请 见 9.5 节 的 介绍 。 以 下 是 该 按钮 的 
单 击 事件 代码 : 
Private Sub btnEdit_Click() 
lfitemEdited ls Nothing Then 
MsgBox "你 没有 选中 任何 记录 ! " vbOKOnly + vblnformation 
Else 
"将 选择 项 的 数据 依次 保存 在 全 局 数组 arrEdited 中 
With frmQryResult.ListViewQry.Selectedltem 


arrEdited = 

Array(.Text, .Subltems(1), .Subltems(2), .Subltems(3), .Subltems(4), .Subltems(5), .Subltems(6), .Su 
bltems(7)) 

End With 

isEditRecord = True "设置 当前 处 于 编辑 销售 记录 状态 

frmlnput.Show "开启 销售 记录 编辑 窗口 
End If 
End Sub 


9.7.8 关闭 按钮 代码 设计 


关闭 窗口 的 代码 十 分 简单 ， 只 需 使 用 Unload 卸载 窗口 即 可 。 下 面 是 该 按钮 的 代码 : 


Private Sub btnClose_Click() 
Unload Me 
End Sub 


9.8 编辑 查询 条 件 窗口 设计 


编辑 查询 条 件 窗口 用 于 查看 或 编辑 单项 查询 条 件 或 总 查询 条 件 。 当 在 查询 销售 数据 设置 
窗 体 中 单 击 相应 查询 条 件 的 【编辑 】 按 钮 时 ， 将 打开 相应 查询 条 件 的 编辑 窗口 。 


办公 应 用 莫 们 -之 禾 


Excel VBA 应 用 开发 经 典 案例 


9.8.1 窗 体 界面 设计 


窗 体 的 界面 十 分 简洁 ， 包 含 了 1 个 文本 框 控件 、2 个 按 四 
钮 。 文 本 框 控件 用 于 显示 被 编辑 的 查询 条 件 。 两 个 按钮 分 别 三 
用 于 执行 编辑 工作 和 退出 窗口 。 如 图 9-38 所 示 的 是 该 窗口 的 珊 


界面 。 

窗口 的 界面 十 分 简单 , 这 里 不 再 对 包含 的 控件 一 一 说 明 。 ”图 9-38 编辑 查询 条 件 窗口 界面 
界面 的 设计 过 程 这 里 也 不 再 说 明 ， 读 者 可 以 参照 前 面 的 窗口 界面 设计 过 程 制作 。 需 要 说 明 的 
是 各 个 控件 的 命名 ， 文 本 框 控件 名 称 为 txtFilterArea，【 确 定 】 按 钮 名 称 为 bnOK，【 取 消 】 
按钮 名 称 为 btnClose。 


9.8.2 ” 窗 体 事件 代码 设计 


窗 体 的 事件 包括 了 窗 体 激活 事件 和 窗 体 印 载 事件 。 窗 体 激活 事件 将 根据 被 选择 项 目 决定 
窗口 中 显示 的 查询 条 件 是 哪个 项 目的 。 窗 体 卸 载 时 需要 重 置 SQL 查询 语句 以 防 干扰 其 他 查询 
条 件 的 编辑 ， 另 外 还 需要 激活 原 查询 设置 窗 体 。 两 个 事件 的 执行 流程 都 十 分 简单 ， 这 里 不 列 
出 过 程 的 流程 图 。 

以 下 是 这 两 个 事件 的 代码 ; 


Private Sub UserForm_Activate() ' 窗 体 被 激活 时 ， 设 置 文本 框 显示 内 容 
With frmFilterEdit 
Select Case intFilterlndex 'intFitterlndex 在 单 击 编辑 按钮 时 已 被 确定 
Case 1 


Me.Caption = "商场 查询 条 件 " 

-txtFilterArea.Text = strMarketFitter 。“'strMarketFilter 在 查询 设置 窗口 中 被 确定 
Case2 

Me.Caption = "产品 型 号 查询 条 件 " 

.txtFilterArea.Text = strProductFilter “'strProductFilter 在 查询 设置 窗口 中 被 确定 
Case 3 

Me.Caption = "尺寸 查询 条 件 " 

‘txtFilterArea. Text = strSizeFilter 'strSizeFilter 在 查询 设置 窗口 中 被 确定 
Case 4 

Me.Caption = "数量 查询 条 件 " 

.txtFilterArea.Text = strNumberFilter ”'strNumberFilter 在 查询 设置 窗口 中 被 确定 
Case5 

Me.Caption = "价格 查询 条 件 " 

‘txtFilterArea. Text = strPriceFilter 'strPriceFilter 在 查询 设置 窗口 中 被 确定 
Case6 

Me.Caption = "时 间 查 询 条件 " 

‘txtFilterArea. Text = strDateFilter 'strDateFilter 在 查询 设置 窗口 中 被 确定 
Case7 

Me.Caption = "品牌 查询 条 件 " 

‘txtFilterArea. Text = strMarkFilter 'strMarkFilter 在 查询 设置 窗口 中 被 确定 


mh 
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Case8 
Me.Caption = "总 体 查询 条 件 " 
Me.btnOK.Enabled = False 总 查询 条 件 不 能 被 直接 编辑 ， 只 能 修改 各 子 项 目 
txtFilterArea. Text = strSQL 
End Select 
End With 
End Sub 


Private Sub UserForm_Terminate() 

StrSQL ="™" ' 重 置 SQL 查询 语句 

frmQuery.Show "显示 查询 设置 窗 体 

End Sub 

代码 说 明 : 

口 ”窗口 初始 化 事件 中 使 用 到 的 公共 变量 在 查询 条 件 设置 窗口 中 被 设置 。 这 些 变 量 包 括 
intFilterIndex 、 strMarketFilter 、 strProductFilter 、 strSizeFilter 、 strNumberFilter 、 
strPriceFilter、 strDateFilter 和 strMarkFilter。 

口 为 了 确定 窗口 最 终 显 示 的 哪 一 个 分 项 的 查询 条 件 , 程序 使 用 了 一 个 Select Case 语句 。 
针对 intFilterIndex 参数 的 值 决定 窗口 显示 内 容 以 及 按钮 的 状态 。 


9.8.3 文本 框 改变 事件 


当 窗 口 打开 的 是 总 查询 字符 串 时 ， 窗 口 的 【确定 】 按 钮 是 灰色 的 ， 即 总 查询 字符 串 是 不 
能 在 编辑 窗口 中 修改 的 。 当 需要 修改 时 ， 需 要 修改 相应 子 项 目的 查询 条 件 。 但 用 户 可 能 会 在 
文本 框 中 试图 改变 总 查询 字符 串 。 文 本 框 改变 事件 正 是 用 于 检测 用 户 这 一 动作 ， 以 显示 提示 
信息 ， 提 示 用 户 在 子 项 目 中 修改 条 件 。 该 文本 框 改变 事件 的 代码 如 下 : 

Private Sub txtFilterArea_Change() 

If txtFilterArea. Text <> strSQL And intFilterlIndex = 8 Then "如 果 是 针对 strSQL 进行 修改 时 , 提示 

非法 操作 
txtFilterArea. Text = strSQL 
MsgBox "总 体 查询 条 件 不 能 在 此 修改 ， 你 只 能 在 单项 目的 修改 按钮 种 做 该 动作 ! ", vbOKOnly + 
vblnformation 
End If 
End Sub 


9.8.4 确定 按钮 代码 设计 


单 击 【确定 】 按 钮 后 ， 程 序 将 根据 intFilterIndex 全 局 变量 确定 被 修改 的 单项 查询 条 件 的 
归属 ， 然 后 对 应 查询 条 件 修 改 为 文本 框 中 的 值 。 总 查询 字符 串 是 根据 单项 字符 串 获 取 的 ， 因 
此 这 里 不 需要 考虑 总 查询 字符 串 的 修改 情况 。 实 际 上 总 查询 字符 串 在 编辑 窗口 中 也 是 无 法 被 
修改 的 。 


Private Sub btnOK_Click() "编辑 单项 筛选 条 件 
With frmFilterEdit 


TE < 人 


;办公 应 用 非 党 乞 够 


Excel VBA 应 用 开发 经 典 案例 


Select Case intFilterlndex "由 intFilterlndex 区 分 是 针对 哪个 单项 筛选 条 件 
Case 1 
strMarketFilter = .txtFilterArea.Text 
Case2 
strProductFilter = .txtFilterArea. Text 
Case3 
strSizeF ilter = .txtFilterArea. Text 
Case 4 
strNumberFilter = .txtFilterArea. Text 
Case5 
strPriceFilter = .txtFilterArea. Text 
Case6 
strDateF ilter = .txtFilterArea. Text 
Case7 
strMarkFilter = .txtFilterArea.Text 
End Select 
End With 
Unload Me 
End Sub 


9.8.5 ”关闭 按钮 代码 设计 


【关闭 】 按 钮 用 于 和 扼 载 窗 体 ， 代 码 十 分 简单 ， 使 用 Unload 印 载 掉 窗口 即 可 。 代 码 如 下 : 


Private Sub btnClose_Click() 
Unload Me 
End Sub 


9.9 系统 测试 


本 节 是 系统 的 测试 部 分 ,该 部 分 测试 内 容 包含 销售 数据 的 输入 、 查 询 和 编辑 3 个 部 分 。 这 
里 假设 基本 数据 已 经 建立 ， 系 统 中 也 已 经 建立 了 部 分 的 基础 数据 信息 。 以 下 将 通过 3 个 小 节 
分 别 介绍 3 部 分 内 容 的 测试 过 程 。 
9.9.1 销售 数据 输入 


数据 较 入 窑 体 | 


届 寺 得 根 都 


销售 数据 的 输入 十 分 简便 , 没有 过 程 操作 。 在 Excel 2007 
ee 【数据 输入 与 查询 】|【 输 入 数据 窗 
命令 ,在 随后 打开 的 【数据 输入 窗 体 】 对 话 框 中 依次 输 
et 品牌 、 产 品 型 号 、 数 量 和 单价 信息 ， 最 后 单 击 a 
【确定 】 按 钮 即 可 ， 如 图 9-39 所 示 。 


图 9-39 【数据 输入 窗 体 】 对 话 框 


mA 
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9.9.2 查询 销售 数据 


(1) 在 Excel 2007 的 加 载 宏 菜 单 中 依次 选择 【数据 输入 与 查询 】|【 数 据 库 查 询 】 命 令 ， 

随后 系统 打开 【查询 窗 体 】 对 话 框 ， 如 图 9-40 所 示 。 此 处 首先 查询 数据 库 所 有 记录 数据 ， 因 
而 不 需要 设置 任何 查询 条 件 ， 直 接 单 击 【查看 查询 集合 】 按 钮 即 可 ， 如 图 9-41 所 示 。 

加 


Ey 
8 | 20070506122027 

8 20070508122033 
20000 8 20070508122038 
33 29 20070529193611 


ET 站 EE 
询 条 件 输入 区 


二 | 应 加 | 修改 EE 
” 查看 查询 集合 
关闭 


8 20070508122104 
2999 8 20070506122118 
16 20070508122133 
0080226091720 


rays: [| | 
RT | 
数量 : Fa 引 | 添加 | 修改 | | -运算 方式 : 
“ Im wl) 
om FI ls 


导出 所 有 项 重 置 妈 显 示 知 选项 编辑 关闭 
图 9-40 【查询 窗 体 】 对 话 框 图 9-41 数据 库 所 有 记录 数据 
(2) 为 了 查询 指定 的 销售 数据 ， 需 要 退回 到 【查询 窗 体 】 对 话 框 。 这 里 查询 所 有 商场 名 
为 “大 润 发 春 申 ” 的 销售 数据 ， 首 先 在 查询 窗口 中 设置 商场 名 称 为 “大 润 发 春 申 ”， 然 后 单 
击 【 添 加 ]】 按钮 ， 如 图 9-42 所 示 。 随 后 单 击 【 查 看 查询 集合 】 按 钮 ， 最 后 的 查询 结果 如 图 9-43 


所 示 。 
eee 2 T20070508122027 
口 大 泣 发 春 中 15 32LBIR EE 200 8 | 20070508122033 
EI > [aE EE CS EN FE EE ER 
于 条 件 输 和 区: [ET 2D5A 2 2 3 20010529193611 
商场 名 称 : | Ei] se Ez 
ap: | = 
raus: | wen Ezdl 
Ai | 关闭 
wa: FF [| 后 | 和 ES 
| 
m: FI mlm) | 
| suma 基 | 3 | par 可 | se | zm | 
图 9-42 【查询 窗 体 】 对 话 框 图 9-43 条 件 查询 结果 


9.9.3 ”编辑 销售 数据 


(1) 这 里 做 出 的 编辑 操作 即 修改 图 9-43 中 第 一 条 记录 的 产品 型 号 。 用户 只 需要 双击 该 条 
记录 即 可 ， 随 后 打开 该 条 记录 的 编辑 窗口 ， 如 图 9-44 所 示 。 


(2) 在 窗口 中 单 击 【产品 型 号 】 下 拉 列 表 框 ， 在 下 拉 列 表 框 中 选择 42LC2RR 型 号 ， 如 
图 9-45 所 示 。【 尺 寸 】 文 本 框 中 的 数据 会 被 自动 刷新 。 


EE 局 
三 于 和 入 区 一 南村 从 区 一 
商场 名 称 : Fas 可 商场 名 称 : Fa 可 
mm | ww | 
产品 型 号 Fe [本 PS: 四 区 | 
尺 d: 才 除 尺寸: 司 一 一 一 删除 
当量 : EF ee 
单价 : 后 
提示 : 
[Ee 
图 9-44 销售 记录 编辑 图 9-45 ”修改 销售 数据 
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第 10 章 学 生 座位 编排 系统 


在 日 常 教务 工作 中 ,往往 需要 针对 学 生 的 情况 对 学 生 的 座位 做 出 调整 。 本 系统 正 是 针对 
这 一 日 常 教务 工作 需要 辅助 教师 完成 学 生 座 位 编排 工作 。 在 该 系统 中 ， 用 户 只 需要 建立 学 
生 的 基本 信息 即 可 完成 学 生 座位 编排 ， 除 了 自动 编排 方式 外 用 户 还 可 以 自己 进行 后 期 调整 


焉 礁 ; 
10.1 系统 概述 
在 系统 中 完成 学 生 座 位 重 排 工作 , 首先 需要 建立 学 生 的 资 


料 , 然后 对 重 排 后 的 座次 行列 位 置 以 及 讲台 位 置 进 行 设置 ， 最 


后 用 户 可 以 选择 系统 自动 排列 座次 或 者 手动 调整 学 生 座次 完 


成 排列 学 生 座次 位 置 工作 。 使 用 该 系统 完成 编排 座位 工作 的 操 


作 流程 图 如 图 10-1 所 示 。 
本 系统 一 共 建 立 了 3 个 工作 表 、5 个 窗 体 以 及 1 个 代码 模 


块 。 以 下 是 这 些 表 、 窗 体 和 代码 模块 的 功能 简 述 。 


口 


口 


口 
口 


首页 表 : 首页 中 包含 了 所 有 的 功能 实现 按钮 。 用户 依 。 图 10-1 编排 座位 操作 流程 图 
次 完成 各 项 操作 后 即 可 获得 最 终 的 座位 重 排 表 。 

学 生 表 : 该 表 保存 了 所 有 学 生 的 资料 信息 。 通 过 首页 的 【学 生 名 输入 】 按 钮 可 以 直 
接 跳 转 到 该 页 面 。 

编排 表 ， 该 表 显 示 学 生 座 次 编排 效果 。 在 该 表 中 ， 还 可 以 对 编排 效果 进行 调整 。 
辅助 输入 窗口 ， 该 窗口 用 于 辅助 学 生 资料 信息 输入 。 在 学 生 表 中 ， 单 击 【 辅 助 输入 】 
按钮 ， 该 窗口 将 被 打开 。 

讲台 位 置 窗口 ， 该 窗口 用 于 设置 座次 编排 表 中 讲台 所 处 位 置 。 

交换 位 置 窗口 该 窗口 用 于 手动 调整 某 两 位 学 生 的 座次 位 置 。 该 功能 通过 首页 的 【 调 
整 座位 】 按 钮 激发。 

手动 调整 窗口 ， 该 窗口 用 于 手动 将 学 生 编排 到 学 生 座位 表 中 。 每 当 一 个 学 生 被 安排 
后 ， 窗 口中 学 生 名 列表 将 把 该 学 生 信 息 从 列表 中 删除 。 

行列 设置 窗口 ， 该 窗口 用 于 控制 最 终 编排 学 生 座位 表 的 行列 数 。 程 序 将 把 所 定义 的 
行列 用 边框 包含 起 来 ， 以 区 别 于 其 他 Excel 表 的 单元 格 。 

公用 模块 :该 模块 包含 了 公用 变量 定义 、 首 页 的 跳 转 过 程 宏 以 及 其 他 自 定义 功能 
过 程 。 
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10.1.1 知识 点 一 : 合并 单元 格 


在 Excel 2007 中 ， 为 了 达到 对 齐 、 美 观 的 效果 经 常 需要 将 部 分 单元 格 进行 合并 。 通 过 手 
动 操作 合并 单元 格 十 分 简便 ， 首 先 选择 需要 合并 的 单元 格 ， 在 【开始 】 菜 单 中 依次 选择 【对 
齐 方式 】|【 合 并 单 格 】 命 令 即 可 。 或 者 直接 右 击 这 些 选 定 的 单元 格 ， 然 后 在 弹出 的 快捷 菜单 
中 选择 【设置 单元 格格 式 】 命 令 。 用 户 也 可 以 通过 按 Ctrl+l 组 合 键 打开 【设置 单元 格格 式 】 
对 话 框 ， 在 弹出 的 对 话 框 中 选中 【合并 单元 格 】 复 选 框 ( 如 图 10-2 所 示 ) 。 


EE] 
数字。 对齐 | 字体 | 这 得 | 填充 | 保护 | 


文本 对 齐 方式 一 
水 平 对 齐 只 ; 
| 冤 规 了 列 坦 中 
征 直 对 齐 四 ) 一 司 
Br 


厂 两 高 分 数 对 并 加 ) 


根据 内 容 。 ”到 


图 10-2 【设置 单元 格格 式 】 对 话 框 


要 通过 代码 完成 该 操作 时 ， 只 需要 将 这 些 单元 格 的 MergeCells 属性 设置 为 True 即 可 。 设 
置 完成 后 ， 可 以 通过 这 些 单元 格 的 MergeArea 对 象 完成 对 合并 单元 格 的 格式 及 值 的 设置 。 以 
下 是 一 代码 示例 : 

With sheet1.Cells(1, 1) 


.Resize(2, 1).MergeCells = True ' 合 并 sheet1 的 A1 和 A2 单元 格 

.MergeArea.Value = "合并 单元 格 " "通过 A1 访问 MergeArea 对 象 , 并 设置 合并 单元 格 值 

.MergeArea.Borders.LineStyle = xIDouble ”' 通 过 A1 访问 MergeArea 对 象 , 并 设置 合并 单元 格 边 
框 样式 


.MergeArea.HorizontalAlignment = xlCenter ' 设 置 合并 单元 格 的 水 平 对 齐 方式 
.MergeArea.VerticalAlignment = xlCenter ”' 设 置 合并 单元 格 的 垂直 对 齐 方 式 
End With 


10.1.2 ”知识 点 二 : 定义 批注 


在 Excel 2007 中 定义 单元 格 的 批注 ， 可 以 对 部 分 不 易 懂 的 数据 进行 解释 ， 以 便于 需要 时 
查看 。 批 注 的 建立 在 Excel 2007 中 也 可 以 通过 手动 或 代码 建立 。 

手动 操作 建立 批注 的 方法 是 : 选中 需要 建立 批注 的 单元 格 ， 然 后 右 击 该 单元 格 ， 在 弹出 
的 快捷 菜单 中 选择 【插入 批注 】 命 令 (如 图 10-3 所 示 ) 后 ， 就 可 以 在 打开 的 【批注 】 文 本 框 
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中 输入 批注 信息 (如 图 10-4 所 示 ) 。 


美 车 中 

le] 

区 和 Rp) 
迁 泽 性 类 站- 
揪 入 @- 
者 除 D)… 
清除 内 容 (N) 
第 远 (E) 
排序 (Q) 

了 揪 入 批注 M) 

加 设 本 单元 属 属 式 虽 -- 
从 下 拉 列 要 中 远 择 (~ 

喀 旺 示 拼 冯 字段 (9) 


i 
命名 单元 格 区 域 (R)… 多 
EE 4 
图 10-3 插入 批注 图 10-4 ”编辑 批注 信息 
通过 代码 建立 批注 也 十 分 简便 。 使 用 单元 格 对 象 的 AddComment 方法 可 以 为 该 单元 格 添 
加 批注 。 通 过 单元 格 的 Comment 对 象 的 Text 属性 可 以 设置 单元 格 批注 的 文字 内 容 。 以 下 代码 
为 给 工作 表 1 中 的 E5 单元 格 添加 批注 并 将 该 批注 显示 出 来 。 


With Worksheets(" 工 作 表 1").Range("e5").AddComment ' 添 加 批注 
.Visible = True ' 显 示 该 批注 
.Text "在 此 输入 如 批注 信息 " "设置 批注 文字 

End With 


值得 注意 的 一 点 是 : 批注 的 文字 内 容 不 能 使 用 赋值 语句 完成 ， 请 仔细 查看 上 面 的 代码 ， 
该 代码 并 没有 出 现 赋值 符号 “=”， 而 是 直接 将 显示 数据 跟随 在 Text 属性 后 面 。 


10.1.3 ”知识 点 三 : Split 函数 的 使 用 


Split 函数 是 VBA 中 一 个 功能 强大 的 字符 串 处 理 函 数 。 该 函数 可 以 快速 将 某 一 字符 串 按照 
某 间 断 字符 进行 分 割 。 分 割 完成 后 ， 函 数 将 各 个 子 字符 串 保存 到 一 个 下 标 从 零 开始 的 一 维 数 
组 中 。 下 面 是 该 函数 的 使 用 语法 格式 : 

一 维 数组 =Split( 原 字符 串 , 分 割 字符 串 , 子 字符 串 数 ， 比 较 方 式 ) 

其 中 ， 只 有 原 字符 串 参 数 是 必需 的 。 分 割 字符 串 参 数 默认 为 空格 ， 分 割 原 字符 串 时 ， 将 
以 该 字符 串 为 分 割 间距 。 子 字符 串 数 定 义 返回 子 字 符 串 的 数量 ， 默 认为 返回 所 有 子 字符 串 。 
比较 方式 定义 判别 子 字符 串 时 的 比较 方式 。 以 下 是 该 函数 的 一 个 使 用 实例 。 

myArray=Split("1/2/3/4/5" 

上 面 的 代码 中 ，Split 函数 将 原 字符 串 “1/2/3/4/5” 按 “/” 进 行 分 割 ， 得 到 一 包含 5 个 元 
素 的 一 维 数组 ， 然 后 将 该 数组 赋 给 myArray 数组 变量 。 在 立即 窗口 中 可 以 输入 debug.print 
myArray(0) 检 测 上 面 代码 获得 数组 第 一 个 元 素 的 值 ， 其 显示 的 结果 为 1。 


_ 
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10.2 首页 设计 


系统 概述 中 ， 对 于 首页 表 已 经 做 了 部 分 功能 介绍 。 本 小 节 将 详细 介绍 首页 的 界面 设计 与 
代码 设计 。 通 过 首页 各 个 按钮 和 设置 项 目 ， 用 户 可 以 直接 完成 编排 工作 中 所 有 的 流程 步骤 。 
由 于 界面 中 所 使 用 的 按钮 是 通过 形状 实现 的 ， 因 而 不 存在 按钮 可 用 状态 设置 代码 。 在 实际 操 
作 中 ， 请 用 户 注意 操作 的 顺序 。 


10.2.1 首页 界面 设计 


首页 中 所 有 的 按钮 都 是 使 用 形状 完成 的 ， 其 单 击 时 执行 的 宏 在 公用 模块 中 定义 。 除 了 这 
些 按 钮 外 ， 首 页 中 还 包含 了 一 些 系 统 设 置 控件 。 该 首页 的 界面 如 图 10-5 所 示 。 
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图 10-5 ”学生 座位 编排 表 首 页 界面 


首页 中 共 包 含 了 6 个 图 形 ， 其 中 一 个 图 形 作为 界面 框架 ， 其 余 的 作为 按钮 ， 还 包含 1 个 
分 组 框 控件 以 及 4 个 单 选 按钮 控件 。 以 下 是 该 首页 中 包含 的 这 些 按钮 形状 以 及 设置 控件 的 功 


能 简 述 。 
口 【学 生 名 输入 】 按 钮 : 单 击 该 按钮 ， 将 跳 转 到 学 生 表 中 ， 用 户 在 学 生 表 中 可 以 建立 
所 有 学 生 的 信息 。 
口 【行列 设置 】 按 钮 : 单 击 该 按钮 ， 打 开行 列 设 置 窗口 ， 在 该 窗口 中 可 以 设置 最 终 座 
次 编排 表 的 行列 数 。 
口 【讲台 位 置 】 按 钮 : 单 击 该 按钮 ， 打 开讲 台 设 置 窗口 ， 在 该 窗口 中 可 以 设置 讲台 在 
座次 表 的 位 置 。 


口 【编排 座位 】 按 钮 : 单 击 该 按钮 后 ， 程 序 将 进入 座次 编排 工作 。 在 这 个 过 程 中 ， 可 
以 选择 编排 座次 位 置 或 手动 设置 座次 。 

口 【调整 座位 】 按 钮 : 单 击 该 按钮 后 ， 可 以 将 已 制作 好 座次 表 中 的 某 两 个 学 生 的 座次 
进行 调换 。 


办 公 应 用 闫 党 之 狗 


Excel VBA 应 用 开发 经 典 案例 


口 ”编排 表 显示 设置 该 框架 控件 中 ,包含 了 4 个 单 选 按钮 。 这 些 单 选 按钮 用 于 设置 座 
次 表 中 显示 的 类 型 。 

建立 该 首页 界面 的 步骤 如 下 : 

(1) 在 Excel 2007 中 依次 选择 【插入 】|【 形 状 】|【 和 矩形 】 命 令 。 在 首页 空白 区 域 单 击 鼠 
标 并 拖 动 以 产生 一 适当 大 小 的 矩形 。 右 击 该 算 形 ， 在 弹出 的 快捷 菜单 中 选择 【设置 形状 格式 】 
命令 ， 在 打开 的 【设置 形状 格式 】 对 话 框 中 选择 【填充 】 选 项 并 选中 其 右 侧 的 【纯色 填充 】 
单 选 按钮 。 随 后 在 【颜色 】 下 拉 列 表 框 中 选择 【 白色， 背景 1，5%】 选 项 ， 如 图 10-6 所 示 。 
然后 再 选择 【阴影 】 选 项 并 展开 【 预 设 】 下 拉 列 表 框 ， 在 【外 部 】 一 栏 中 选择 【 右 下 斜 偏 移 】 
选项 ， 如 图 10-7 所 示 。 最 后 选择 【文本 框 】 选 项 ， 在 【文字 版 式 】 分 类 中 的 【垂直 对 齐 方式 】 
下 拉 列 表 框 中 选择 【 顶端 对 齐 】 选 项 。 


外 部 
TT 回 Fr 
j 国 ( 
副 国 图 

图 10-6 和 拢 形 填充 颜色 设置 图 10-7 矩形 阴影 设置 


(2) 右 击 刚 创建 的 矩形 形状 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 。 随 后 输入 文 
字 内 容 为 “学 生 座位 表 制 作 系统 ”。 

(3) 在 Excel 2007 中 依次 选择 【插入 】|【 形 状 】|【 圆 角 和 矩形 】 命 令 。 在 步骤 (1) 和 步 
又 (2) 创建 的 矩形 形状 中 插入 一 圆 角 矩形 作为 按钮 形状 。 随 后 右 击 该 圆 角 按钮 ， 在 弹出 的 快 
捷 菜 单 中 选择 【设置 形状 格式 】 命 令 ， 在 打开 的 【设置 形状 格式 】 对 话 框 中 选择 【填充 】 选 
项 并 选中 【渐变 填充 】 单 选 按 钮 。 在 【 预 设 颜色 】 下 拉 列 表 框 并 选择 【 麦 浪 深 滨 】 选 项 ， 
如 图 10-8 所 示 。 然 后 选择 【颜色 】 设 置 下 拉 列 表 框 ， 在 其 中 选择 【橙色 ， 强 调 文字 颜色 6， 
淡色 ，80%】 选 项 ， 如 图 10-9 所 示 。 


图 10-8 ” 圆 角 矩形 填充 设置 图 10-9 圆 角 和 矩形 渐变 颜色 设置 


(4) 将 步骤 (3) 建立 的 贺 角 逢 形 复制 4 份 ， 按 照 图 10-5 所 示 将 这 5 个 圆 角 逢 形 排放 在 
矩形 形状 内 部 。 然 后 依次 右 击 这 5 个 圆 角 矩 形 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 。 
设置 各 和 矩形 内 部 的 文字 内 容 依次 为 “学 生 名 输入 ”、“ 行 列 设 置 ”、“ 讲 台 位 置 ”、“ 编 排 
座位 ”和 “调整 座位 ”。 

(5) 右 击 【 学 生 名 输入 】 按 包 并 选择 【指定 宏 】 命令。 在 打开 的 【指定 宏 】 对 话 框 中 和 


Ah 
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择 【 学 生 输 入 】 宏 过 程 ， 如 图 10-10 所 示 ， 然 后 单 击 【 确 定 】 按 钮 即 可 。 与 该 按钮 的 设置 方法 
类 似 ， 依 次 设置 其 他 按钮 的 宏 过 程 ， 其 对 应 关系 如 表 10-1 所 示 。 
3 


这 本 加 下 [所 有 6 工作 了 
全 二 和 = 一 == 一 竺 


Cu] ww | 


图 10-10 【指定 宏 】 对 话 框 
表 10-1 按钮 与 宏 名 对 应 关系 表 


按钮 名 宏 名 
行列 设置 行列 设置 
讲台 位 置 讲台 位 置 
编排 座位 编排 座位 
调整 座位 调整 座位 


(6) 在 Excel 2007 中 依次 选择 【开发 工具 】|【 插 入 】| 【表单 控件 】|【 分 组 框 】 命 令 。 
在 以 上 创建 圆 角 和 矩形 的 下 方 插 入 一 适当 大 小 的 分 组 框 。 随 后 右 击 该 分 组 框 ， 在 弹出 的 快捷 菜 
单 中 选择 【编辑 文字 】 命 令 ， 将 其 文字 内 容 设 置 为 【编排 表 显 示 设 置 】。 

(7) 在 Excel 2007 中 依次 选择 【开发 工具 】|【 插 入 】| 【表单 控件 】| 【选项 按钮 】 命 令 。 
在 以 上 创建 分 组 框 内 依次 插入 4 个 选项 按钮 。 随 后 依次 右 击 这 些 选项 按钮 ， 在 弹出 的 快捷 菜 
单 中 选择 【编辑 文字 】 命 令 。 依 次 输入 文字 内 容 为 “显示 姓名 ”、“ 显 示 性 别 ”、“ 显 示 视 
力 分 类 ”和 “显示 评价 分 类 ”。 

(8) 右 击 其 中 一 个 选项 按钮 ， 在 弹出 的 快捷 菜单 中 选择 【设置 控件 格式 】 命 令 。 在 随后 
打开 的 【设置 控件 格式 】 对 话 框 中 选择 【控制 】 选 项 卡 。 将 【单元 格 链接 】 设 置 为 首页 的 O1 
单元 格 ， 如 图 10-11 所 示 。 


| 
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图 10-11 设置 选项 按钮 格式 
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从 注意 :' Excel 2007 默认 的 菜单 中 没有 开发 工具 菜单 。 要 使 用 该 菜单 插入 控件 ， 需 要 用 户 手 
动 设置 。 设置 方法 在 第 4 章 的 知识 点 中 已 有 介绍 。 


10.2.2 首页 代码 设计 


首页 表 中 并 不 包含 任何 代码 ， 但 是 首页 中 各 个 跳 转 按钮 都 有 其 指定 宏 。 这 一 部 分 将 讲述 


首页 中 各 个 按钮 的 宏 代码 ， 
绍 如 下 : 


口 
口 


口 


口 


口 


以 上 大 部 分 按钮 的 宏 代 码 都 比较 简单 ， 
较 多 ， 该 过 程 将 单独 列 出 介绍 。 


学 生 输 入 宏 过 程 : 
行列 设置 宏 过 程 : 


变量 中 。 


讲台 位 置 宏 过程 : 


共 变量 中 。 


编排 座位 宏 过 程 : 


配 座次 。 


调整 座位 宏 过 程 : 


行 手动 调整 。 


Sub 学 生 输 入 () 


Worksheets(" 学 生 表 ").Select 


End Sub 


Sub 行列 设置 () 
frm 行列 设置 .Show 
End Sub 


Sub 讲台 位 置 () 
frm 讲台 位 置 .Show 
End Sub 


Sub 调整 座位 () 


Worksheets(" 编 排 表 ").Select 


frm 交换 位 置 .Show 
End Sub 


这 些 宏 过 程 都 被 保存 在 公共 


打开 编排 表 行列 数 设置 窗 


模块 中 。 这 些 宏 过 程 及 其 大 致 功能 


该 过 程 激活 学 生 表 ， 以 便 用 户 在 学 生 表 中 完成 学 生 资料 建立 工作 。 


， 设 置 后 获得 行列 数 将 被 保存 到 公共 


打开 讲台 位 置 设置 窗口 ， 设 置 后 获得 的 讲台 位 置信 息 被 保存 到 公 


执行 编排 座位 操作 。 用 户 在 该 过 程 执行 中 途 可 以 设置 是 否 自动 分 


打开 调整 座次 窗口 ， 并 跳 转 到 编排 表 中 ， 以 便 用 户 对 学 生 座次 进 


本 章 将 不 再 逐个 分 节 介 绍 。 但 编排 座位 宏 代 码 比 
以 下 是 其 他 各 个 宏 过 程 的 代码 解释 。 


"激活 学 生 表 


"显示 行列 设置 窗口 


"显示 讲台 位 置 设置 窗口 


"激活 编排 表 


"显示 交换 位 置 窗口 


10.2.3 ”编排 座位 宏 代 码 设计 


编排 座位 宏 过 程 按照 用 户 设置 的 行列 信息 以 及 讲台 位 置信 息 完成 编排 座次 工 


的 执行 流程 如 图 10-12 所 示 。 
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图 10-12 编排 座位 宏 流 程 图 


首先 过 程 将 检测 行列 信息 与 讲台 位 置信 息 是 否 被 正确 输入 ， 否 则 将 会 退出 过 程 ， 然 后 根 
居 行 列 信息 、 讲 台 位 置信 息 给 该 座次 表 所 使 用 到 的 单元 格 设置 边框 。 用 户 可 以 根据 该 边框 划 
定 的 范围 获取 该 座次 表 的 大 体 布局 ， 然 后 程序 将 询问 是 否 自 动 分 配 座次 ， 和 否则 将 会 弹出 手动 
分 配 窗口 ， 用 户 通 过 该 窗口 可 以 手动 分 配 座次 。 该 过 程 的 代码 如 下 : 
Sub 编排 座位 () 
Dim ws As Worksheet, rg As Range, rowCount As Integer 
Dim intStartRow As Integer, intStartColumn As Integer 
Dim strTemp As String 
Set ws = Worksheets(" 编 排 表 ") 
ws.Cells.Clear ' 清 除 编排 表 的 所 有 内 容 ， 以 便 重 排 格 式 与 显示 数据 
"检测 行 数 和 列 数 信息 是 否 被 正确 设置 
lfint 列 数 <= 0 Or int 行 数 <= 0 Then 
MsgBox "座位 的 行列 数 未 定义 !", vblnformation + vbOKOnly, "提示 " "提示 行列 数 未 定义 


Exit Sub ' 退 出 过 程 
End If 
' 检 测 讲台 位 置 是 否 被 设置 
If Len(str 讲台 位 置 ) <= 0 Then 
MsgBox "讲台 位 置 未 定义 ! ", vbOKOnly + vblnformation, "提示 " "提示 讲台 位 置 未 定义 
Exit Sub "退出 过 程 
End If 
ws.Activate ' 激 活 编 排 表 
以 下 设置 讲台 的 显示 位 置 ， 为 了 将 讲台 显示 在 座位 表 的 中 间 位 置 , 需要 对 讲台 位 置 、 列 数 的 奇偶 情况 分 
别 操作 


If str 讲台 位 置 = " 左 侧 " Then 
lfint 列 数 Mod 2 = 0 Then 
With ws.Cells(int 列 数 12, 1) 
' 列 数 为 偶数 时 ， 需 要 使 用 中 间 两 个 单元 格 显示 讲台 ， 以 让 讲台 居中 


.Resize(2, 1).MergeCells = True ' 合 并 中 间 两 个 单元 格 
.MergeArea.Value = "讲台 " "设置 合并 单元 格 的 显示 内 容 
.MergeArea.Borders.LineStyle = xlDouble "设置 合并 单元 格 的 边框 
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.MergeArea.HorizontalAlignment = xlCenter "设置 合并 单元 格 的 水 平 对 齐 方式 
.MergeArea.VerticalAlignment = xlICenter "设置 合并 单元 格 的 垂直 对 齐 方式 
End With 
Else 
' 列 数 为 奇数 时 ， 只 需要 中 间 一 个 单元 格 ， 即 可 将 讲台 居中 
With ws.Cells(int 列 数 /2 +1, 1) 


.Value = "讲台 " "设置 讲台 单元 格 显示 内 容 
.Borders.LineStyle = xIDouble "设置 讲台 单元 格 边框 
.HorizontalAlignment = xlCenter "设置 讲台 单元 格 水 平 对 齐 方式 
End With 
End 上 f 
Set rg = ws.Cells(i, j) 
Else 


lfint 列 数 Mod 2 = 0 Then 
With ws.Cells(1, int 列 数 / 2) 
.Resize(1, 2).MergeCells = True 
.MergeArea.Value = "讲台 " 
.MergeArea.Borders.LineStyle = xIDouble 
.MergeArea.HorizontalAlignment = xlCenter 
.MergeArea.VerticalAlignment = xlICenter 


End With 
Else 
With ws.Cells(1, int 列 数 /12+1) 
.Value = "讲台 " 


.Borders.LineStyle = xIDouble 
.HorizontalAlignment = xlCenter 
End With 
End If 
Set rg = ws.Cells(j, i) 
End If 
"设置 编排 表 所 用 行列 单元 格 的 边框 
Fori= 1To int 列 数 
Forj=2Toint 行 数 +1 
"讲台 的 位 置 决定 了 编排 表 的 行列 布局 ， 讲 台 在 左 侧 和 讲台 在 项 部 ， 其 行列 设置 是 互 换 的 
' 这 里 需要 根据 讲台 位 置 情况 定义 需要 设置 单元 格 的 位 置 
If str 讲台 位 置 = " 左 侧 " Then 
Set rg = ws.Cells(i,j) 


Else 
Set rg = ws.Cells(j, i) 
End If 
rg.Borders.LineStyle = xlDouble "设置 单元 格 的 边框 
Next 


Next 

' 询 问 是 否 自动 分 配 学 生 或 手动 分 配 并 完成 分 配 工作 

rowCount = 1 

上 MsgBox(" 是 否 自动 分 配 学 生 ? ", vbQuestion + vbOKCancel, "询问 ") = vbOK Then 
Fori= 1Toint 列 数 
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Forj=2Toint 行 数 + 1 

' 根 据 讲 台 位 置 确定 别 分 配 单元 格 位 置 

f str 讲台 位 置 = " 左 侧 " Then 
Set rg = ws.Cells(i, j) 

Else 
Set rg = ws.Cells(), i) 

End If 

If rowCount <= rowsCount Then 
' 给 选 定单 元 格 赋值 ， 该 值 的 类 型 由 首页 的 设置 单元 格 O1 确定 
rg = Worksheets(" 学 生 表 ").Cells(rowCount + 1, Worksheets(" 首 页 ").Range("O1") + 1) 
将 当前 学 生 所 有 信息 保存 到 一 临时 字符 串 变量 
strTemp = "序号 : " & Worksheets(" 学 生 表 ").Cells(rowCount + 1, 1) & Chr(10) 
strTemp = strTemp & "姓名 : "& Worksheets(" 学 生 表 ").Cells(rowCount + 1, 2) & Chr(10) 
strTemp = strTemp & "性 别 :" & Worksheets(" 学 生 表 ").Cells(rowCount + 1, 3) & Chr(10) 
strTemp = strTemp & "视力 : "& Worksheets(" 学 生 表 ").Cells(rowCount + 1, 4) & Chr(10) 
strTemp = strTemp & "评价 :" & Worksheets(" 学 生 表 ").Cells(rowCount + 1, 5) 
将 学 生 所 有 信息 写 入 选 定单 元 格 的 批注 中 
With rg.AddComment 


.Visible = False 
.Text strTemp 
End With 
rowCount = rowCount + 1 ' 登 记 已 自动 分 配 学 生 的 数量 
End If 
Next 
Next 
Else 
frm 手动 调整 .Show ' 显 示 手 动 调整 窗口 
End If 
Set ws = Nothing 
End Sub 
代码 说 明 : 


口 学 生 座次 自动 分 配 过 程 中 ， 需 将 学 生 的 对 应 信息 显示 在 被 分 配 单 元 格 中 。 这 些 需 要 
显示 在 单元 格 中 的 信息 类 型 是 由 首页 中 编排 表 显 示 设 置 中 的 选项 按钮 确定 的 。 这 些 
选项 一 共 4 个, 第 一 个 选项 按钮 显示 学 生 名 被 单 击 时 ， 其 链接 的 O1 单元 格 的 值 被 设 
置 为 1。 第 二 个 选项 按钮 被 单 击 时 ， 该 值 为 2， 依 次 类 推 。 而 在 学 生 表 中 对 应 的 学 生 
名 、 性 别 、 视 力 和 评价 栏 被 序号 栏 后 移 了 一 栏 ， 因 而 程序 中 使 用 “Worksheets(" 首 页 ") 
.Range("O1")+ 1” 来 定位 该 被 分 配 学 生 的 显示 信息 列 号 。 

口 “” 当 用 户 选择 了 “显示 学 生 名 ”外 的 显示 设置 后 ， 编 排 表 中 显示 的 内 容 无 法 反映 相应 
的 学 生 名 称 等 其 他 情况 。 为 了 便于 用 户 及 时 查询 被 安排 学 生 的 详细 情况 ， 程 序 通 
过 单元 格 批注 保存 该 学 生 的 详细 情况 。 该 批注 在 该 单元 格 被 单 击 时 会 显示 出 来 ， 上 
于 该 显示 操作 属于 编排 表 的 设计 部 分 ， 这 里 没有 介绍 。 该 部 分 代码 请 见 10.4 节 具 体 
介绍 。 
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10.3 学 生 表 设 计 


学 生 表 主 要 用 于 完成 学 生 信息 输入 工作 。 该 表 的 结构 并 不 复杂 ， 包 含 了 5 列 相关 学 生 信 
息 ， 还 有 辅助 输入 学 生 信 息 的 【辅助 输入 】 按 钮 和 【二 字 名 称 对 齐 】 按 钮 。 以 下 是 这 两 个 按 


钮 功能 的 简单 介绍 : 
口 【辅助 输入 】 按 钮 :该 按钮 被 单 击 时 ， 打 开 辅 助 输入 学 生 信息 窗口 。 该 窗口 只 用 于 
建立 新 的 学 生 信息 ， 没 有 其 他 的 编辑 、 删 除 与 查询 功能 。 
口 


【二 字 名 称 对 齐 】 按 钮 : 学 生 的 名 字 可 能 只 有 两 个 汉字 。 在 三 字 名 称 居 多 时 ， 显 示 


的 编排 表 姓 名 不 易 对 齐 。 该 按钮 将 在 学 生 名 列 的 二 字 名 称 中 添加 两 个 空格 以 与 三 字 
名 称 对 齐 。 


10.3.1 ”学生 表 界面 设计 


学 生 表 的 界面 如 图 10-13 所 示 。 该 表 的 界面 没有 过 多 的 形状 设计 ， 以 下 将 简 述 该 表 的 建立 


大 学 生 座位 彤 排 系统 version J 人 xsb [自动 保存 的 ] yx 
A B C 
序号 学 生 名 性别 


图 10-13 学生 表 界面 设计 
(1) 右 击 首页 的 标签 ， 在 弹出 的 快捷 菜单 中 选择 【新 建 】 命 令 ， 打 开 【 新 建 】 对 话 框 。 
在 对 话 框 的 【常用 】 选 项 卡 中 选择 【工作 表 】 选 项 ， 如 图 10-14 所 示 。 单 击 【确定 】 按 钮 插入 
一 新 工作 表 。 随 后 双击 该 工作 表 的 标签 ， 修 改 该 工作 表 的 标签 文字 为 “学 生 表 ”。 


x 
党 用 | 电子 表格 方案 | 
ejalel 
而 曾 名 国 人 EE 
mi i 
天 
office Online 模板 外 ) 取消 
图 10-14 插入 新 表 


(2) 在 该 工作 表 的 首 行 中 ， 依 次 输入 列 标题 “序号 ”、“ 学 生 名 ”、“ 性 别 ”、“ 视 力 ” 


prs 


_ 
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和 “评定 ”。 然 后 在 Excel 2007 中 依次 选择 【视图 】| 【窗口 】I 【冻结 窗口 】I【 浆 结 首 行 】 命 
令 。 此 时 该 工作 表 的 标题 行将 被 固定 下 来 。 

(3) 复制 首页 的 两 个 贺 角 算 形 到 “学 生 表 ”工作 表 中 。 然 后 依次 右 击 两 圆 角 外 形 ， 在 弹 
出 的 快捷 菜单 中 选择 【编辑 文字 】 命令。 设置 两 加 角 算 形 的 文字 内 容 分 别 为 “辅助 输入 ”和 
“二 字 名 称 对 齐 ”。 

(4) 再 次 右 击 以 上 创建 的 两 个 国 角 算 形 ， 在 弹出 的 快捷 菜单 中 选择 【指定 宏 】 命 令 ， 打 
开 【 指 定 宏 】 对 话 框 。 在 【指定 宏 】 对 话 框 中 分 别 设置 其 安 过 程 为 “ 畏 助 输入 ”过 程 和 “二 
字 名 称 对 齐 ”过 程 。 然 后 将 首 行 的 高 度 调整 到 与 两 加 角 算 形 形状 到 高 度 。 此 时 贺 角 算 形 将 包 
合 在 首 行 之 内 ， 因 而 不 会 随 表 的 滚动 而 深 动 。 


10.3.2 学生 表 代码 设计 


学 生 表 中 包含 了 表 的 事件 代码 以 及 相应 的 按钮 宏 代码 ， 具 体 是 表 失 去 激活 事件 、 辅 助 输 
入 过 程 和 二 字 名 称 对 齐 过 程 。 这 些 代码 都 十 分 简单 ， 这 里 不 再 讲述 。 以 下 是 这 些 事 件 与 按钮 
的 宏 代 码 : 

Private Sub Worksheet Deactivate() 

" 当 表 失去 焦点 时 ， 刷 新 rowsCount 公共 变量 ， 该 变量 记录 的 是 已 建立 学 生 资料 的 数量 


rowsCount = Worksheets(" 学 生 表 ").Cells(Rows.Count, 1).End(xIUp).Row 
End Sub 


Sub 辅助 输入 () 
frm 辅助 输入 .Show "显示 辅助 输入 窗口 
End Sub 


Sub 二 字 名 称 对 齐 () 
Dim rg As Range 
rowsCount = Worksheets(" 学 生 表 ").Cells(Rows.Count, 1).End(xIUp).Row "刷新 rowsCount 变量 
Fori= 2 To rowsCount 
Set rg = Worksheets(" 学 生 表 ").Range("B" & i) 


If Len(rg) = 2 Then ' 检 测 学 生 名 是 否 是 二 字 名 称 
rg=Left(rg, 1)&" "& Right(rg, 1) ' 二 字 名 称 中 添加 两 空格 
End ff 
Next 
Set rg = Nothing 
End Sub 


10.4 编排 表 设 计 


编排 表 实 际 上 是 一 个 空 表 ， 该 表 初 始 时 不 包含 任何 数据 ， 即 使 存在 数据 ， 在 编排 操作 中 ， 
程序 都 会 自动 清除 数据 与 格式 信息 。 但 该 表 中 仍然 包含 了 部 分 代码 ， 这 些 代 码 的 用 途 在 随后 
的 代码 设计 中 讲述 。 
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10.4.1 编排 表 界 面 设计 


下 面 给 出 的 编排 表 界面 是 程序 自动 生成 编排 数据 ,该 界面 不 是 手动 完成 的 .界面 如 图 10-15 
所 示 。 


EEC 


iso a0 wi 


图 10-15 学 生 编排 表 界面 
图 中 保存 当前 选 定 学 生 的 详细 信息 的 标签 被 显示 出 来 ， 是 因为 该 学 生 所 在 单元 格 被 选择 
造成 的 。 该 图 是 使 用 显示 学 生 名 以 及 讲台 在 顶端 设置 下 的 编排 结果 。 只 要 用 户 不 再 次 单 击 首 
页 中 的 【编排 座次 】 按 钮 ， 该 表 的 数据 不 会 被 清除 。 用 户 可 以 选择 首页 中 其 他 的 显示 设置 ， 
来 查看 编排 表 中 其 他 特征 的 分 布 情况 ， 以 便于 调整 座次 。 


10.4.2 ”编排 表 代 码 设计 


在 编排 表 中 共 包 含 了 3 个 事件 代码 ， 分 别 是 工作 表 激 活 事 件 、 工 作 表 失去 激活 事件 和 工 
作 表 单元 格 选择 改变 事件 。 这 3 个 事件 分 别 完成 的 功能 大 致 描述 如 下 : 
口 “工作 表 激活 事件 : 当 工作 表 被 激活 时 ， 用 户 可 能 在 首页 中 刚 设 置 了 新 的 显示 设置 项 。 
此 时 需要 把 编排 表 中 的 所 有 数据 重新 显示 出 来 。 工 作 表 激活 事件 正 是 完成 该 工作 。 
口 “工作 表 失 去 激活 事件 : 当 工作 表 失 去 激活 时 ， 需 要 将 所 有 批注 项 目 都 隐藏 起 来 。 以 
免 在 下 次 进入 编排 表 时 ， 原 来 被 显示 的 批注 造成 干扰 。 
口 “工作 表单 元 格 选择 改变 事件 : 当 编 排 表 中 选择 单元 格 发 生变 化 时 ， 需 要 确定 该 单元 
格 是 否 需要 显示 批注 项 目 。 当 需要 显示 批注 时 ， 应 该 首先 隐藏 原 显 示 批 注 项 然后 显 
示 当 前 选择 单元 格 的 批注 。 该 工作 由 该 事件 完成 。 


Dim rgPrevious As Range 


Private Sub Worksheet_Activate() 
Dim strTemp As String, myArray() As String 
Dim i As Integer 
' 循 环 所 有 批注 项 ， 从 批注 中 获取 需要 显示 在 单元 格 中 的 数据 ， 然 后 将 该 数据 写 入 到 对 应 单元 格 中 
For Each cmt In Sheet3.Comments 
myArray = Splittcmt.Text, Chr(10)) 分割 批 注 信息 ， 将 其 保存 到 一 个 自 定 义 数组 中 
strTemp = myArray(Worksheets(" 首 页 ").Range("O1")) ”“”' 获 取 需 显示 信息 的 所 有 字符 串 数据 
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i= InStr(1, strTemp, ": ") 获取 冒 号 的 位 置 
strTemp = Right(strTemp, Len(strTemp) -i) 获取 需 显示 到 单元 格 的 信息 
cmt.Parent.Value = strTemp ' 给 单元 格 赋值 

Next 

End Sub 


Private Sub Worksheet Deactivate() 
' 循 环 所 有 批注 ， 将 所 有 批注 的 Visible 属性 设置 为 False 
For Each cmt In Sheet3.Comments 


cmt.Visible = False ' 隐 藏 批注 
Next 
Set rgPrevious = Nothing ' 置 空 rgPrevious 单元 格 对 象 
End Sub 


Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

On Error GoTo End Sub 

' 当 没有 原 选择 单元 格 时 ， 将 当前 选择 单元 格 设置 为 原 选 择 单元 格 ， 并 将 该 单元 格 的 批注 显示 出 来 
If rgPrevious ls Nothing Then 


Set rgPrevious = Target 蚊 rgPrevious 单元 格 对 象 赋值 
rgPrevious.Comment.Visible = True ' 显 示 选 择 单元 格 的 批注 
Exit Sub 

Else 
' 当 存在 原 选择 单元 格 且 该 单元 格 不 是 当前 选择 单元 格 时 ,首先 隐藏 原单 元 格 的 批注 , 然后 显示 选择 
单元 格 批注 
If rgPrevious ls Target Then Exit Sub ' 原 单元 格 就 是 当前 选择 单元 格 时 ， 退 出 过 程 
rgPrevious.Comment.Visible = False ' 隐 藏 原 选择 单元 格 批注 
Target.Comment.Visible = True ' 显 示 现在 选择 单元 格 批注 
Set rgPrevious = Target ' 重 置 rgPrevious 单元 格 对 象 

End If 

End_Sub: 

End Sub 

代码 说 明 : 


口 在 代码 中 ， 定 义 了 一 个 单元 格 对 象 局 部 变量 ， 该 变量 用 于 记录 原 选择 单元 格 。 当 用 
户 在 编排 表 中 选择 了 一 个 单元 格 时 ， 将 会 触发 单元 格 选 择 改变 事件 (鼠标 和 键盘 操 
作 都 会 触发 事件 ) 。 此 时 ， 程 序 将 把 原 选择 单元 格 的 批注 隐藏 起 来 ， 然 后 显示 当前 
选择 单元 格 的 批注 ， 最 后 把 当前 选择 单元 格 定义 为 原 选择 单元 格 。 如 此 循环 往复 
完成 批注 的 显示 和 隐藏 工作 。 

口 “在 工作 表 激 活 事 件 中 ， 需 要 重新 设置 单元 格 显示 数据 。 学 生 的 所 有 信息 资料 实际 上 
已 经 保存 在 了 该 单元 格 的 批注 之 中 。 这 些 批 注资 料 将 学 生 的 所 有 信息 项 目 通过 chr(10) 
非 打印 字符 连接 。 该 非 打 印字 符 将 造成 换行 效果 ， 因 而 在 批注 显示 时 ， 看 到 的 信息 
条 目 是 逐 行 显示 的 。 

口 通过 Split 函数 按照 chr(10) 字 符 分 割 后 ， 获 得 的 字符 串 信息 仍然 不 适合 显示 在 相应 单 
元 格 上 ， 因 为 其 中 包含 了 一 些 提示 信息 。 但 是 可 以 根据 提示 信息 部 分 的 冒号 位 置 获 
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取 正 确 的 显示 信息 数据 。 程 序 使 用 InStr 函数 获取 冒号 在 字符 串 中 的 位 置 ， 然 后 通过 


Right 函数 获取 的 正确 的 显示 数据 。 


10.5 辅助 输入 窗口 设计 


辅助 输入 窗口 用 于 辅助 用 户 在 学 生 表 中 完成 学 生 信息 输入 工作 。 该 窗口 只 能 用 于 进行 当 
生 信息 建立 操作 ， 不 包含 学 生 资 料 信息 编辑 、 删 除 和 查询 操作 。 该 窗口 的 主要 作用 是 保证 输 
入 的 学 生 信息 按 行 排列 而 不 出 空 行 数据 。 


10.5.1 辅助 输入 窗口 界面 设计 


该 窗口 包含 了 5 项 有 关 学 生 的 信息 资料 ， 分 别 是 序号 、 学 
生 名 、 性 别 、 视 力 和 评定 项 。 其 中 序号 是 系统 自动 产生 的 ， 其 
他 各 个 项 目 都 需要 用 户 自己 手动 建立 。 该 窗口 的 界面 如 图 10-16 
所 示 。 

窗口 中 一 共 包 含 了 6 个 标签 控件 ,其 中 5 个 用 于 显示 提示 信 
息 ， 另 外 1 个 用 于 显示 自动 生成 的 序号 ， 该 序号 并 不 固定 。 窗 。 图 10.16 辅助 输入 窗口 界面 
口中 包含 1 个 文本 框 控件 、3 个 复合 框 控件 和 1 个 【确认 】 按 钮 。 

表 10-2 列 出 了 除 5 个 显示 提示 信息 外 的 所 有 控件 的 控件 名 、 控 件 类 型 和 控件 说 明 。 


表 10-2 辅助 输入 窗口 控件 列表 


控件 名 称 [ 控 件 类 型 | 控件 说 明 
a ee 
txt 学 生 名 ”| ”文本 框 。 | 该 文本 框 中 用 于 设置 学 生 的 学 生 名 

| 
该 复合 框 设置 学 生 的 视力 状况 。 复 合 框 将 学 生 视 力 分 为 4 个 级 别 。 分别 是 


中 po 
comb 视力 复合 框 “好 ”、“ 较 好 ”、“ 较 差 "“ 美 ” 
四 该 复合 框 设 置 教师 对 学 生 学 习 情况 的 评价 等 级 .一 共 包 含 了 4 个 等 级 “优秀 ”、 
comb 评定 复合 框 ee < 合格 ” “ 差 * 
家 按钮 该 按钮 被 选择 后 ， 程 序 将 把 当前 输入 的 学 生 资料 填写 到 学 生 表 中 。 其 中 学 生 


名 不 能 为 空 


建立 该 窗口 的 步骤 如 下 : 

(1) 在 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 在 属性 窗口 中 将 该 窗 体 
的 名 称 属性 设置 为 “frm 辅助 输入 ”， 如 图 10-17 所 示 。 

(2) 在 工具 箱 中 选择 标签 控件 。 在 窗 体 中 连续 插入 6 个 标签 控件 。 在 属性 窗口 中 将 第 二 
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个 标签 的 名 称 属性 设置 为 “lab 序号 ”, 其 他 标签 保持 默认 即 可 。Caption 属性 依次 设置 为 :“ 序 
号 : ”、“”、“ 学 生 名 : ”、“ 性 别 : ”、“ 视 力 : ”和 “评定 ， ”。 注 意 第 二 个 标签 的 
Caption 属性 被 设置 为 空 ， 如 图 10-18 所 示 。 


尾 性 - rm 辅助 输入 | 


图 10-17 辅助 输入 窗 体 属性 设计 图 10-18 ”辅助 输入 窗 体 效果 示意 图 


(3) 在 工具 箱 中 选择 文本 框 控件 。 在 “学 生 名 : ”标签 控件 右 侧 插 入 一 文本 框 控件 。 然 
后 在 属性 窗口 中 设置 该 文本 框 的 名 称 属性 为 “txt 学 生 名 ”。 

(4) 在 工具 箱 中 选择 复合 框 控件 。 在 “性 别 : ”、“ 视 力 : ”、“ 评 定 : ”标签 控件 右 
侧 分 别 插入 一 个 复合 框 。 随 后 在 属性 窗口 中 设置 这 些 复 
合 框 的 名 称 属性 依次 为 “comb 性 别 ”、“comb 视力 ” 
和 “comb 评定 ”。 Style 属性 都 设置 为 pe 
2-fmStyleDropDownList， 如 图 10-19 所 示 。 i 和 | 

(5) 在 工具 箱 中 选择 按钮 控件 。 然 后 在 窗 体 的 下 方 
插入 一 个 按钮 。 随 后 在 属性 窗口 中 设置 该 按钮 的 Caption 
属性 为 “确认 ”， 名 称 属 性 为 “btn 确认 ”。 


图 10-19 设置 复合 框 控 件 的 Style 属性 


10.5.2 ”窗口 初始 化 代码 设计 


辅助 输入 窗口 被 初始 化 时 , 需要 完成 部 分 工作 ， 
包括 计算 序号 并 显示 、 初 始 化 性 别 复合 框 项 目 、 初 
始 化 视力 复合 框 项 目 、 初 始 化 评定 复合 框 项 目 以 及 
将 鼠标 输入 焦点 定位 到 学 生 各 输入 框 中 。 这 些 工作 二 
并 没有 执行 顺序 , 在 本 程序 中 其 执行 流程 如 图 10-20 
所 示 。 定位 鼠标 焦点 
以 下 是 该 窗口 初始 化 的 代码 解释 : 图 10.20 辅助 输入 窗口 初始 化 过 程 流程 图 


Private Sub UserForm_lnitialize() 
rowsCount = Worksheets(" 学 生 表 ").Cells(Rows.Count, 1).End(xIUp).Row 
' 计 算 序 号 并 将 序号 显示 在 序号 标签 上 
Ifrowscount<>1 then 
lab 序号 .Caption = CStr(Worksheets(" 学 生 表 ").Cells(rowsCount, 1).Value + 1) 
else 
lab 序号 .Caption= “1” 
End If 
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' 初 始 化 性 别 复合 框 项 目 


With comb 性 别 
.Clear ' 清 除 性 别 复 合 框 项 目 
.Addltem " 男 " ' 添 加 第 一 个 项 目 
.Addltem " 女 " ' 添 加 第 二 个 项 目 
.Value = " 男 " "指定 复合 框 的 初始 显示 值 

End With 

' 初 始 化 视力 复合 框 项 目 

With comb 视力 
.Clear ' 清 除 视力 复合 框 项 目 
.Addltem "好 " ' 添 加 第 一 个 项 目 
.Addltem " 较 好 " ' 添 加 第 二 个 项 目 
.Addltem " 较 差 " ' 添 加 第 三 个 项 目 
.Addltem " 差 " "添加 第 四 个 项 目 
.Value = "好 " "指定 复合 框 的 初始 显示 值 

End With 

' 初 始 化 评定 复合 框 项 目 

With comb 评定 
.Clear ' 清 除 评定 复合 框 项 目 
.Addltem "优秀 " ' 添 加 第 一 个 项 目 
.Addltem "优良 " ' 添 加 第 二 个 项 目 
.Addltem "合格 " ' 添 加 第 三 个 项 目 
.Addltem " 差 " "添加 第 四 个 项 目 
.Value = "优秀 " "指定 复合 框 的 初始 显示 值 

End With 

' 将 鼠标 输入 焦点 定位 到 学 生 名 输入 框 中 

txt 学 生 名 .SetFocus 

End Sub 

代码 说 明 : 

口 系统 自动 产生 的 序号 是 根据 学 生 表 最 后 一 位 学 生 的 序号 获取 的 。 但 是 有 可 能 在 学 

表 中 没有 任何 学 生 的 资料 信息 ， 此 时 没有 最 后 一 位 学 生 的 序号 可 以 获取 。 pr 


种 意外 ， 程 序 使 用 一 个 下 语句 将 这 种 情况 的 序号 设置 为 1。 


如 果 采 用 了 输入 文本 框 ， 


对 性 别 、 视 力 和 评定 项 目 都 采用 固定 输入 项 目 是 为 了 便于 最 后 编排 表 的 比较 调整 。 
用 户 在 这 些 项 目 中 输入 的 信息 资料 将 会 十 分 混乱 。 这 些 泥 


乱 的 信息 资料 在 编排 表 中 没有 任何 参考 比较 价值 。 这 些 复合 框 的 Style 属性 被 设置 为 


2-fmStyleDropDownList 后 


10.5.3 ”确认 按钮 单 击 事件 代码 设计 


单 击 pe 按钮 后 
中 ， 只 有 学 
生 表 中 

Private Sub btn 确认 _Click() 

"检测 学 生 名 是 否 输入 
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程序 首先 需要 检测 用 户 输入 的 学 
是 必要 的 ， 其 他 的 项 目 都 可 以 不 用 输入 。 然 后 程序 将 把 该 学 生 的 信息 写 入 学 
， ee rowsCount 变量 累加 1 来 重新 记录 已 建立 信息 的 学 


， 复 合 框 将 不 能 使 用 键盘 输入 数据 。 


生 信息 是 否 满足 要 求 。 在 该 实例 


生 数 量 。 
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lf Len(txt 学 生 名 .Text) <= 0 Then 
MsgBox "请 输入 学 生 名 ! ", vblnformation + vbOKOnly, "提示 "” ' 提 示 未 输入 学 生 名 


End If 

' 向 学 生 表 中 添加 学 生 信息 

With Worksheets(" 学 生 表 ") 
.Cells(rowsCount + 1, 1) = lab 序号 .Caption "添加 序号 
.Cells(rowsCount + 1, 2) = txt 学 生 名 .Text "添加 学 生 名 
.Cells(rowsCount + 1, 3) = comb 性 别 .Text ' 添 加 性 别 
.Cells(rowsCount + 1, 4) = comb 视力 .Text "添加 视力 
.Cells(rowsCount + 1, 5) = comb 评定 .Text "添加 评定 

End With 

rowsCount = rowsCount + 1 "累计 已 登记 信息 的 学 生 数量 

Unload Me ' 退 出 窗口 

End Sub 


10.6 讲台 位 置 设置 窗口 设计 


讲台 位 置 设置 窗口 中 可 以 设置 讲台 最 终 在 编排 表 中 的 位 置 。 通 过 该 项 设置 ， 可 以 控制 纺 
排 表 的 纵横 显示 方式 。 


10.6.1 窗口 界面 设计 


窗口 的 控件 数量 不 多 ， 这 里 不 再 以 表格 的 形式 对 各 个 控件 进行 描述 。 窗 口 包含 了 1 个 标 
签 控件 、!1 个 复合 框 控件 和 1 个 按钮 。 标 签 控件 用 于 提示 其 右 侧 的 复合 框 控件 用 于 输入 讲台 位 
团 。 复 合 框 控件 用 于 输入 讲台 在 编排 表 中 的 位 置 。【 确 认 】 按 钮 用 于 保存 讲台 位 置 到 公共 变 
量 ， 该 公共 变量 在 系统 制作 编排 表 时 被 调用 。 如 图 10-21 所 示 的 是 该 窗口 的 界面 。 

建立 该 窗口 的 步骤 比较 简单 ， 以 下 简 述 该 窗口 的 建立 步骤 。 

(1) 在 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 在 属性 窗口 中 将 该 窗 体 
的 名 称 属性 设置 为 “frm 讲台 位 置 ”， 如 图 10-22 所 示 。 


图 10-21 讲台 位 置 设置 窗口 界面 图 10-22 讲台 位 置 窗 体 属性 设置 


(2) 在 工具 箱 中 选择 标签 控件 。 在 窗 体 的 左上 侧 
插入 一 个 标签 ， 在 属性 窗口 中 设置 Caption 属性 为 “ 讲 
台 位 置 ; ”， 如 图 10-23 所 示 。 

(3) 在 工具 箱 中 选择 复合 框 控件 。 在 “讲台 位 置 ” 
标签 控件 右 侧 插入 一 个 复合 框 。 在 属性 窗口 中 设置 图 10.23 讲台 位 置 窗 体 效果 示意 图 
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Style 属性 为 2-ftmStyleDropDownList。 名 称 属性 设置 为 “comb 讲台 位 置 ”。 


(4) 在 工具 箱 中 选择 按钮 控件 。 在 窗口 的 下 部 插入 一 个 按钮 。 在 属性 窗口 中 设置 该 按钮 
的 Caption 为 “确认 ”， 名 称 属性 设置 为 “btn 确认 ”。 


10.6.2 ”窗口 代码 设计 


讲台 位 置 窗口 中 的 代码 也 不 多 ， 只 有 两 个 事件 过 程 ， 分 别 是 【确认 】 按 钮 单 击 事件 和 窗 
口 初 始 化 事件 。【 确认 】 按 钮 被 单 击 时 ， 程 序 将 用 户 所 设置 的 讲台 位 置 保存 到 公共 变量 “str 
讲台 位 置 ” 中 。 在 重新 生成 编排 表 时 ， 新 设置 的 讲台 位 置 将 发 挥 作 用 。 窗 口 初始 化 时 ， 需 要 
为 讲台 位 置 复 合 框 设置 项 目 和 值 。 以 下 是 这 两 个 事件 过 程 的 代码 解释 : 

Private Sub btn 确认 _Click() 

str 讲台 位 置 = comb 讲台 位 置 .Text "保存 讲台 位 置 设置 


Unload Me "卸载 窗口 
End Sub 
Private Sub UserForm_lnitialize() 
comb 讲台 位 置 .Addltem " 左 侧 " ' 设 置 第 一 个 复合 框 项 目 
comb 讲台 位 置 .Addltem "顶部 " "设置 第 二 个 复合 框 项 目 
"设置 讲台 位 置 复合 框 的 值 
lf Len(str 讲台 位 置 ) Then 
comb 讲台 位 置 .Text = str 讲台 位 置 ' 当 讲台 位 置 公共 变量 不 为 空 时 ， 复 合 框 显示 该 公共 变量 的 值 
Else 
comb 讲台 位 置 .Text = " 左 侧 " ' 当 讲台 位 置 公 共 变 量 不 为 空 时 ， 复 合 框 显 示 默认 值 
End If 
End Sub 


10.7 交换 位 置 窗口 设计 


交换 位 置 窗口 用 于 在 编排 表 中 对 两 个 学 生 的 座次 进行 调整 。 该 窗口 在 首页 中 单 击 【 调 整 
座位 】 按 钮 时 被 打开 。 


10.7.1 窗口 界面 设计 


窗口 中 控件 数量 不 多 ， 包 含 了 2 个 标签 控件 、2 个 RefEdit 控件 和 1 个 按钮 控件 。2 个 标 
签 控件 用 于 提示 其 右 侧 的 RefEdit 控件 的 作用 对 象 ,2 个 RefEdit 控件 保存 被 交换 内 容 的 两 个 单 
元 格 的 位 置信 息 。 交 换 按 钮 完成 交换 的 操作 。 如 图 10-24 所 示 的 是 该 窗口 的 界面 效果 。 

建立 该 窗口 的 步骤 如 下 : 

(1) 在 VBE 开发 环境 中 依次 选择 【插入 】|【 用 户 窗 体 】 命 令 。 在 属性 窗口 中 将 该 窗 体 
的 名 称 属性 设置 为 “frm 交换 位 置 ”， 如 图 10-25 所 示 。 
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尾 性 - rm 交换 位 置 上 | 
人 re 交换 位 置 UserForn 号 | 


图 10-24 ”交换 位 置 窗口 界面 图 10-25 交换 位 置 窗 体 属性 设置 
(2) 在 工具 箱 中 选择 标签 控件 。 在 窗口 的 左上 侧 插入 


两 个 标签 .在 属性 窗口 中 设置 两 标签 控件 的 Caption 属性 依 
次 为 “交换 者 : ”和 “被 交换 者 : ”， 如 图 10-26 所 示 。 
(3) 在 工具 箱 中 选择 RefEdit 控件 。 在 两 标签 控件 右 
侧 各 插入 一 个 RefEdit 控件 。 在 属性 窗口 中 依次 设置 这 两 个 
RefEdit 控件 的 名 称 属 性 为 "Ref 交换 者 ”和 “Ref 被 交换 者 ”。 
(4) 在 工具 箱 中 选择 按钮 控件 。 在 窗口 的 下 部 插入 一 个 按钮 。 在 属性 窗口 中 设置 该 按钮 
的 Caption 为 “交换 ”， 名 称 属性 为 “btn 交换 ”。 


图 10-26 交换 位 置 窗 体 效果 示意 图 


10.7.2 窗口 代码 设计 


窗口 中 仅 包含 了 一 个 交换 按钮 单 击 事件 。 该 按钮 被 单 击 时 ， 要 完成 两 个 工作 。 一 方面 要 
将 选择 的 两 个 单元 格 的 显示 内 容 交换 过 来 ， 另 一 方面 还 要 将 选择 单元 格 的 批注 内 容 也 交换 过 
来 。 以 下 是 该 按钮 单 击 事件 的 代码 解释 : 

Private Sub btn 交换 _Click() 

Dim strTemp As String 

' 交 换 单 元 格 显示 数据 

strTemp = Range(Ref 交换 者 .Value).Value "保存 第 一 个 单元 格 的 显示 内 容 

Range(Ref 交换 者 .Value) = Range(Ref 被 交换 者 .Value) “' 将 第 二 个 单元 格 的 显示 内 容 赋 给 第 一 个 单元 格 

Range(Ref 被 交换 者 .Value) = strTemp "第 二 个 单元 格 从 临时 变量 中 获取 显示 数据 

"交换 单元 格 的 批注 信息 

strTemp = Range(Ref 交换 者 .Value).Comment.Text "保存 第 一 个 单元 格 的 批注 

Range(Ref 交换 者 .Value).Comment.Text Range(Ref 被 交换 者 .Value).Comment.Text ' 第 一 个 单元 格 


获取 批注 
Range(Ref 被 交换 者 .Value).Comment.Text strTemp "第 二 个 单元 格 从 临时 变量 中 获取 批注 
End Sub 
代码 说 明 : 


口 ”在 处 理学 生 信息 交换 的 两 个 任务 的 过 程 中 ， 使 用 同一 个 临时 字符 串 变 量 保存 单元 格 
的 显示 值 以 及 单元 格 的 批注 。 这 并 不 会 造成 两 个 任务 之 间 的 混乱 ， 因 为 两 个 任务 是 
被 依次 执行 的 。 完 成 交换 显示 值 后 ， 临 时 变量 已 经 没有 作用 ， 在 交换 批注 中 修改 临 
时 变量 对 交换 显示 值 没 有 任何 影响 。 

口 ” 当 用 户 使 用 RefEdit 控件 获取 了 交换 单元 格 后 ， 该 控件 中 保存 了 完成 单元 格 路 径 。 因 
而 在 获取 单元 格 对 象 时 直接 使 用 了 Range(Ref 交换 者 .Value), 而 无 需 再 指定 该 单元 格 
的 表 位 置 。 
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10.8 手动 调整 窗口 设计 


手动 调整 窗口 用 于 在 编排 表 中 通过 手动 方式 将 所 有 学 生 编 排 到 表 中 。 在 进行 编排 座位 过 
程 中 ， 程 序 首先 完成 编排 表单 元 格 的 格式 设 定 ， 然 后 询问 用 户 是 否 自动 编排 。 当 用 户 拒绝 自 
动 编排 后 ， 该 窗口 将 被 显示 出 来 。 


10.8.1 窗口 界面 设计 


窗口 中 包含 了 5 个 标签 控件 、1 个 列表 框 控件 和 1 个 按钮 。5 个 标签 控件 用 于 作为 列表 框 
显示 内 容 的 标题 。 列 表 框 中 显示 了 所 有 已 登记 学 生 的 所 有 信息 。【 确 认 】 按 钮 用 于 将 当前 选 
择 的 学 生 信 息 填写 到 编排 表 的 选择 单元 格 中 。 如 图 10-27 所 示 的 是 该 窗口 的 界面 。 

本 窗口 中 的 列表 框 控 件 使 用 了 多 列 数据 显示 ， 通 常情 况 下 使 用 列表 框 时 ， 只 能 使 用 一 列 
数据 值 ， 读 者 可 以 仔细 阅读 本 部 分 的 控件 建立 和 代码 设计 ， 以 了 解 列表 框 多 列 数据 显示 和 使 
用 的 方法 。 以 下 是 该 窗 体 的 建立 步骤 : 

(1) 在 VBE 开发 环境 下 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 在 属性 窗口 中 设置 名 称 
属性 为 “frm 手动 调整 ”，ShowModal 属性 设置 为 False， 如 图 10-28 所 示 。 因 为 该 窗 体 在 使 
用 过 程 中 需要 选择 编排 表 中 的 单元 格 ， 所 以 该 ShowModal 属性 不 能 为 True。 


性 性 -frm 手动 调整 可 
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图 10-27 手动 调整 窗口 界面 图 10-28 手动 调整 窗 体 属性 设置 


(2) 在 工具 箱 中 选择 标签 控件 。 在 窗口 的 顶端 依次 插入 5 个 标签 控件 。 在 属性 窗口 中 依 
次 设置 这 些 控件 的 Caption 属性 为 “序号 ”、“ 学 生 名 ”、“ 性 别 ”、“ 视 力 ” 和 “评价 ”， 
如 图 10-29 所 示 。 

(3) 在 工具 箱 中 选择 文本 框 控 件 。 在 刚 建立 的 标签 控件 下 方 插入 一 列表 框 。 在 属性 窗口 
中 设置 该 列表 框 的 名 称 属性 为 “List 学 生 名 ”，ColumnCount 属性 设置 为 5，ColumnWidth 属 
性 设置 为 “30,35,35,35,35”。ColumnCount 用 于 设置 列表 框 的 列 数 ，ColumnWidth 用 于 设置 每 
列 的 宽度 。 
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图 10-29 手动 调整 窗 体 设计 效果 示意 图 


(4) 在 工具 箱 中 选择 按钮 控件 。 在 窗口 底部 插入 一 按钮 控件 。 在 属性 窗口 中 设置 该 按钮 
的 Caption 属性 为 “确定 ”， 名 称 属性 为 “btn 确定 ”。 

值得 说 明 的 是 : 对 于 列表 框 控件 ， 使 用 多 列 时 ， 仍 然 可 以 只 显示 一 列 数据 出 来 ， 其 他 列 
的 数据 只 是 被 隐藏 起 来 而 已 。 例 如 本 例 中 ， 如 果 将 ColumnWidth 属性 设置 为 “0,35,0,0,0” 后 ， 
该 列表 框 将 只 显示 学 生 名 列 。 另 外 多 列 情况 下 ， 用 户 还 可 以 自 定义 列表 框 选 定 项 目 返 回 值 所 
处 的 列 , 这 是 通过 设置 BoundColumn 属性 完成 的 。 本 例 中 使 用 了 默认 值 1 即 返回 序号 列 的 值 。 
通过 该 项 设置 开发 者 就 可 以 将 每 一 项 被 选择 时 的 返回 值 隐藏 起 来 ， 而 显示 出 来 的 是 用 户 容易 
理解 的 数据 信息 。 


加 


10.8.2 窗口 代码 设计 


本 窗口 的 代码 并 不 长 ， 但 是 其 中 包含 了 列表 框 控件 多 列 数 据 显示 时 的 代码 设置 。 本 小 节 
将 详细 介绍 该 部 分 代码 设计 ， 以 让 读者 能 清晰 了 解 列表 框 多 列 数据 显示 的 代码 设计 。 
本 窗口 中 包含 了 3 个 事件 过 程 代码 ， 分 别 是 窗口 激活 事件 、 窗 口 失去 激活 事件 和 确定 按 
钮 单 击 事 件 。 这 些 事件 过 程 的 功能 简 述 如 下 : 
口 ”窗口 激活 事件 ， 当 窗口 被 激活 时 ， 需 要 重新 刷新 列表 框 中 的 学 生 信息 。 该 事件 将 学 
生 表 中 所 有 学 生 信息 存储 在 一 个 二 维 数组 中 ， 然 后 通过 使 用 列表 框 的 List 属性 将 该 
二 维 数 组 中 的 数据 显示 在 列表 框 中 。 
口 窗口 失去 激活 事件 ， 窗口 失去 激活 时 ， 在 编排 表 中 被 选中 单元 格 的 批注 仍 处 于 被 显 
示 状 态 。 为 了 排除 该 批注 的 显示 干扰 ， 程 序 暂 时 将 批注 隐藏 ， 需 要 显示 时 ， 用 户 再 
次 选择 单元 格 即 可 。 
口 ”确定 按钮 单 击 事件 : 【确定 】 按 钮 被 单 击 时 ， 程 序 首先 需要 确认 4 个 方面 的 事情 ， 
分 别 是 当前 被 激活 的 表 是 否 是 编排 表 、 激 活 单元 格 是 否 有 学 生 已 显示 、 激 活 单 元 格 
是 否 是 讲台 位 置 单元 格 、 激 活 单元 格 的 边框 是 否 存 在 。 这 些 条 件 的 检查 可 以 确保 一 
件 事情 ， 即 只 对 编排 表 中 未 被 安排 的 编排 座次 单元 格 执行 后 续 代码 。 
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Private Sub UserForm_Activate() 
Dim myArray() 


rowsCount = Worksheets(" 学 生 表 ").Cells(Rows.Count, 1).End(xIlUp).Row ”' 获 取 学 生 表 的 数据 行 数 


ReDim myArray(rowsCount -2, 4) 

"给 数组 赋值 

Fori= 2 To rowsCount 
myArray(i -2, 0) = Worksheets(" 学 生 表 ").Cells(i, 1) 
myArray(i -2, 1) = Worksheets(" 学 生 表 ").Cells(i, 2) 
myArray(i -2, 2) = Worksheets(" 学 生 表 ").Cells(i, 3) 
myArray(i -2, 3) = Worksheets(" 学 生 表 ").Cells(i, 4) 
myArray(i -2, 4) = Worksheets(" 学 生 表 ").Cells(i, 5) 

Next 

' 显 示 数 组 数据 到 列表 框 

With List 学 生 名 
.Clear 
.List() = myArray 

End With 

End Sub 


Private Sub UserForm_ Deactivate() 


' 重 新 定义 数组 


"保存 序号 列 数据 
"保存 学 生 名 列 数据 
"保存 性 别 列 数 据 
"保存 视力 列 数据 
"保存 评价 列 数据 


"清除 列表 框 数据 项 目 
' 给 列表 框 赋值 


' 循 环 编排 表 中 所 有 的 批注 项 目 ， 将 所 有 批注 项 目的 可 见 属性 设置 为 False 


For Each cmt In Sheet3.Comments 
cmt.Visible = False 

Next 

End Sub 


Private Sub btn 确定 _Click() 
Dim i As Integer, strTemp As String 
lf ActiveSheet.Name = "编排 表 " And Len(ActiveCell)=0_ 


' 隐 藏 批注 


And ActiveCell <> "讲台 " And ActiveCell.Borders.LineStyle = xlDouble Then 
' 当 编排 表 中 的 选 定单 元 格 是 未 被 编排 的 座位 单元 格 时 ， 执 行 以 下 语句 


i= List 学 生 名 .Value 
List 学 生 名 .Removeltem List 学 生 名 .ListiIndex 
' 给 选 定单 元 格 赋值 并 标记 单元 格 批注 


"获取 列表 框 选 定 项 目的 序号 列 数据 
' 移 除 列表 框 的 选 定 项 目 


ActiveCell = Worksheets(" 学 生 表 ").Cells(i + 1, Worksheets(" 首 页 ").Range("O1")+ 1) ”赋值 
strTemp = "序号 : "& Worksheets(" 学 生 表 ").Cells(i + 1, 1) & Chr(10) ' 序 号 段 字 符 串 
strTemp = strTemp & "姓名 : "& Worksheets(" 学 生 表 ").Cells(i + 1, 2) & Chr(10) “' 连 接 学 生 名 段 


字符 串 


strTemp = strTemp & "性 别 : "& Worksheets(" 学 生 表 ").Cells(i + 1, 3) & Chr(10) “连接 性 别 段 字 


符 串 
strTemp = strTemp & "视力 : "& Worksheets(" 学 生 表 ").Cells(i + 1, 4) & Chr(10) “' 连 接 视力 段 字 
符 串 
strTemp = strTemp & "评价 : "& Worksheets(" 学 生 表 ").Cells(i + 1, 5) "连接 评价 段 字 
符 串 
With ActiveCell.AddComment 
.Visible = False "隐藏 批注 
.Text strTemp ' 将 批注 字符 串 写 入 单元 格 批注 中 
End With 


End If 
End Sub 
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代码 说 明 : 

口 ”使 用 列表 框 控件 建立 多 列 数据 显示 时 ， 首 先 需 要 将 这 些 数据 保存 在 一 个 二 维 数 组 中 。 
代码 中 没有 使 用 Option Base 1 语句 来 定义 数组 的 起 始 索 引号 为 1, 因而 程序 中 定义 二 
维 数组 时 使 用 了 ReDim myArray(rowsCount -2, 4 语句 。 该 数组 包含 元 素 实际 有 
rowsCount-1 行 ，5 列 。 

口 将 所 有 数据 保存 到 数据 后 ， 通 过 列表 框 的 List 属性 可 以 使 列表 框 获取 前 面 二 维 数组 
的 数据 。 当 用 户 选择 列表 框 中 某 一 项 时 ， 该 列表 框 的 返回 值 将 是 被 绑 定 列 的 数值 。 
该 绑 定 列 的 位 置 由 BoundColumn 属性 决定 。 

口 当 需 要 移 除 列表 框 中 的 项 目 时 ， 只 需要 调用 列表 框 的 Removeltem 方法 即 可 ; 该 方法 
接受 选 定 移 除 项 目的 索引 顺序 号 的 参数 。 本 例 中 需要 移 除 被 用 户 选 中 的 项 目 ， 此 时 
可 以 通过 列表 框 的 ListIndex 属性 获取 该 被 选中 项 目的 索引 号 。 


10.9 行列 设置 窗口 设计 


行列 设置 窗口 用 于 设置 座次 编排 表 的 行列 数 。 在 首页 单 击 【编排 座 次 】 按 钮 后 ， 程 序 将 
首先 根据 行列 用 户 设置 的 行列 数 和 讲台 位 置 设置 单元 格 的 边框 。 
10.9.1 窗口 界面 设计 


行列 设置 窗口 的 控件 数量 不 多 ,包含 3 个 标签 控件 、2 个 文本 框 和 和 1 个 确认 按钮 。 其 中 


1 个 标签 用 于 显示 已 建立 信息 的 学 生 数量 ， 其 他 2 个 标签 用 于 显 加 
示 提示 信息 。2 个 文本 框 控件 分 别 用 于 输入 行 数 和 列 数 。 确 认 按 一 
钮 用 于 保存 用 户 设置 行列 数 到 公共 变量 , 该 公共 变量 在 编排 座次 。 wa a 
过 程 中 被 调用 。 图 10.30 是 该 窗口 的 界面 。 [可 


建立 该 窗口 的 步骤 如 下 ; 
(1) 在 VBE 开发 环境 下 依次 选择 【插入 】|【 用 户 窗 体 】 ”图 10-30 行列 设置 窗口 界面 
命令 。 在 属性 窗口 中 设置 窗口 的 名 称 属性 为 “frm 行列 设置 ”， 如 图 10-31 所 示 。 
(2) 在 工具 箱 中 选择 标签 控件 。 在 窗 体 中 连续 插入 3 个 标签 。 在 属性 窗口 中 设置 前 两 个 
标签 的 Caption 属性 依次 为 “座位 列 数 : ”和 “座位 行 数 : 。 随 后 将 第 3 个 标签 的 名 称 属性 设 
置 为 “lab 提示 ”， 如 图 10-32 所 示 。 


下 学 生 库 位 篇 排 承 搞 .xlsm fii 行人 [=| 


屋 性 frm 行列 设置 习 
[EEL 可 


re VserPorn 


图 10-31 行列 设置 窗 体 属性 设置 图 10-32 ”行列 设置 窗 体 设计 效果 示意 图 
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(3) 在 工具 箱 中 选择 文本 框 控 件 。 在 窗口 中 连续 插入 两 个 文本 框 。 在 属性 窗口 中 依次 设 
置 这 两 个 文本 框 控件 的 名 称 属性 为 “txt 列 数 ” 和 “txt 行 数 ”。 

(4) 在 工具 箱 中 选择 按钮 控件 。 在 窗口 底部 插入 一 个 按钮 。 在 属性 窗口 中 设置 按钮 的 
Caption 属性 为 “确认 ”， 名 称 属 性 为 “btn 确认 ”。 


10.9.2 ”窗口 代码 设计 


在 行列 设置 窗口 中 ， 当 用 户 输入 了 某 一 个 数值 后 ， 程 序 会 根据 当前 的 学 生 总 数 自动 来 确 
认 另 外 一 个 数值 。 当 然 用 户 可 以 根据 该 数值 自己 调整 ， 但 是 不 允许 输入 数值 小 于 自动 确认 的 
数值 ， 因 为 自动 确认 数值 已 经 是 容纳 所 有 学 生 的 最 小 数 。 
该 窗口 过 共 包含 了 4 个 事件 过 程 代码 ， 分 别 是 窗口 初始 化 事件 、 列 数 文本 框 更 新 事件 、 
行 数 文 本 框 更 新 事件 和 确认 按钮 单 击 事 件 。 这 4 个 事件 过 程 的 功能 描述 如 下 : 
口 ”窗口 初始 化 事件 ， 窗 口 初始 化 时 ， 需 要 获取 已 登记 信息 的 学 生 数 量 ， 并 将 该 数量 显 
示 在 提示 标签 上 。 
口 列 数 文本 框 更 新 事件 ， 列 数 输入 数据 发 生变 化 时 ， 程 序 需要 根据 用 户 输入 列 数 和 总 
登记 学 生 数 量 确定 一 个 最 小 行 数 ， 并 将 该 最 小 数 显示 在 行 数 文本 框 中 。 
口 行 数 文 本 框 更 新 事件 ， 行 数 输入 数据 发 生变 化 时 ， 程 序 需要 根据 用 户 输入 行 数 和 总 
登记 学 生 数 量 确定 一 个 最 小 列 数 ， 并 将 该 最 小 数 显示 在 列 数 文本 框 中 。 
口 确认 按钮 单 击 事件 : 单 击 【确认 】 按 钮 时 ， 程 序 将 把 用 户 设置 的 行列 数 保存 到 公共 
变量 中 ， 以 便 程序 在 编排 座次 过 程 中 调用 。 
以 下 是 这 些 事件 过 程 的 代码 解释 : 
Private Sub UserForm _lInitialize() 
rowsCount = Worksheets(" 学 生 表 ").Cells(Rows.Count, 1).End(xIUp).Row ”' 获 取 学 生 表 总 行 数 
lab 提示 .Caption = "学 生 表 中 建立 了 <" & rowsCount -1 & "> 名 学 生 名 称 ! ” ' 显 示 登 记 信 息 的 学 生 数 量 
txt 列 数 .SetFocus ' 输 入 焦点 定位 到 列 数 文本 框 
End Sub 


Private Sub txt 列 数 _AfterUpdate() 
Dim i As Integer, j As Integer 


i= txt 列 数 .Value "记录 列 数 数据 
"计算 最 小 行 数 
j= (rowsCount -1)/l ' 获 取 登 记 学 生 数 量 与 列 数 相 除 的 商 数 
Ifi*j < rowsCount -1Then 
txt 行 数 .Text =j + 1 ' 商 数 与 列 数 乘积 小 于 学 生 数 时 ， 最 小 行 数 为 商 数 加 1 
Else 
txt 行 数 .Text =j ' 商 数 与 列 数 乘积 大 于 或 等 于 学 生 数 时 ， 最 小 行 数 为 商 
End If 
End Sub 


Private Sub txt 行 数 _AfterUpdate() 
Dim i As Integer, j As Integer 


Ah 
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i = txt 行 数 .Value "记录 行 数 数据 
"计算 最 小 列 数 
j= (rowsCount -1)/1 "获取 登记 学 生 数 量 与 行 数 相 除 的 商 数 
Ifi*j < rowsCount-1Then 
txt 列 数 .Text =j+ 1 ' 商 数 与 行 数 乘积 小 于 学 生 数 时 ， 最 小 列 数 为 商 数 加 1 
Else 
txt 列 数 .Text =j ' 商 数 与 行 数 乘积 大 于 或 等 于 学 生 数 时 ， 最 小 列 数 为 商 
End If 
End Sub 


Private Sub btn 确认 _Click() 
' 检 测 行列 数 输入 是 否 正确 
上 Clnt(txt 列 数 .Text) * CInt(txt 行 数 .Text) < rowsCount -1 Then 
MsgBox "行列 数 确定 的 总 人 数 小 于 实际 人 数 ， 请 重新 输入 ! ", vblnformation + vbOKOnly, "行列 数 


错误 
txt 列 数 .Text = ' 清 空 列 数 文本 框 
txt 行 数 .Text = " "清空 行 数 文本 框 
txt 列 数 .SetFocus ' 定 位 输入 焦点 到 列 数 文本 框 
Exit Sub ' 退 出 过 程 

End If 

输入 正确 时 ， 保 存 行列 数 到 公共 变量 

int 列 数 = txt 列 数 .Text "保存 列 数 

int 行 数 = txt 行 数 .Text "保存 行 数 

Unload Me 

End Sub 


10.10 系统 测试 


本 章节 展示 了 使 用 系统 为 一 个 实际 班级 学 生 分 配 座次 的 过 程 。 实 例 中 使 用 到 的 学 生 一 共 
50 名 ， 这 里 假设 用 户 已 经 建立 了 这 些 学 生 的 信息 。 测 试 中 实际 需要 完成 的 工作 非常 少 ， 用 户 
只 需要 设置 讲台 位 置 和 行列 数 就 可 以 轻松 完成 座次 的 自动 排列 。 以 下 将 把 测试 内 容 分 为 座次 
编排 设置 与 自动 排列 座次 、 调 整 座次 两 个 部 分 。 


10.10.1 座次 编排 设置 与 自动 排列 座次 


(1) 在 首页 单 击 【 行 列 设置 】 按 钮 ， 系 统 将 弹出 【行列 设置 】 对 话 框 。 这 里 将 学 生 座 
次 分 为 6 列 9 行 ， 此 处 只 需要 输入 列 数 6 即 可 。 程 序 将 会 自动 计算 最 恰当 的 行 数 ， 当 然 用 户 
也 可 以 输入 行 数 ， 程 序 会 自动 计算 最 恰当 的 列 数 。 设 置 完成 后 单 击 【确认 】 即 可 ， 如 图 10-33 

(2) 在 首页 单 击 【讲台 位 置 】 按 钮 ， 系 统 弹 出 【讲台 位 置 】 对 话 框 。 这 里 设置 讲台 位 置 
处 于 编排 表 的 顶端 ， 因 而 选择 顶部 即 可 ， 如 图 10-34 所 示 。 
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四 | 
座位 列 数 : 6 
座位 行 数 : [a 


学 生 表 中 建立 了 650 名 学 生 名 称 


-可 | 


图 10-33 【行列 设置 】 对 话 框 图 10-34 【讲台 位 置 】 对 话 框 


(3) 重新 回 到 首页 ， 单 击 【 编 排 座位 】 按 钮 ， 随 后 弹出 是 否 自动 分 配 座 次 对 话 框 ， 这 里 
单 击 【 确 定 】 按 钮 让 系统 自动 分 配 座次 , 如 图 10-35 所 示 。 分配 完成 后 其 结果 如 图 10-36 所 示 。 
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图 10-35 【是 否 自动 分 配 座次 】 对 话 框 图 10-36 “自动 学 生 座 位 编排 结果 
10.10.2 ”调整 座次 


以 前 面 的 自动 编排 结果 为 基础 ， 对 A2 和 B2 编排 的 学 生 座次 进行 调整 。 

(1) 在 首页 单 击 【调整 座位 】 按 钮 ， 系 统 将 会 自动 激活 编排 表 工 作 表 ， 并 且 打 开 【 交 换 
位 置 】 对 话 框 ， 如 图 10-37 所 示 。 

(2) 单 击 【交换 位 置 】 对 话 框 中 的 交换 者 RefEdit 控件 ， 在 编排 表 中 选择 A2 单元 格 ， 如 
图 10-38 所 示 。 在 【交换 位 置 】 对 话 框 中 单 击 被 交换 者 RefEdit 控件 ， 并 在 编排 表 中 选择 B2 
单元 格 ， 如 图 10-39 所 示 。 最 终 设置 的 结果 如 图 10-40 所 示 。 最 后 单 击 【 交 换 】 按 钮 即 完 成 座 
位 调整 。 


交换 位 置 划 
交换 者 : = 
[me | 
图 10-37 【交换 位 置 】 对 话 框 图 10-38 设置 交换 者 

[Zn zs] 
交 执 者 : EEA7| 
该 六 执 者 : 三 编 持 素 !'sB32 本] 

EE 

图 10-39 设置 被 交换 者 图 10-40 ”交换 设置 结果 
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合同 是 企业 的 命脉 ， 对 签订 的 合同 进行 科学 管理 ， 是 一 份 十 分 重要 的 工作 。 合 同 涵盖 了 
ey 包括 销售 合同 、 购买 合 同 、 设计 合同 和 劳务 合同 等 。 只 有 对 这 些 
合同 采取 积极 而 有 效 的 管理 ， 企 业 才能 掌握 合同 的 具体 执行 情况 ， 才 能 在 合同 的 执行 过 程 中 
掌握 主动 权 。 

本 实例 以 Access 数据 库 为 后 台数 据 库 。 通 过 本 实例 ， 用 户 可 以 了 解 ADO 数据 库 对 象 的 
使 用 。 在 前 面部 分 章节 , 逐一 介绍 了 DAO 读 写 Excel 数据 库 、 读 写 Access 数据 库 文件 的 实例 。 
用 户 可 以 结合 这 些 内 容 ， 在 自己 的 应 用 开发 中 选择 适用 的 开发 方式 。 


11.1 系统 概论 


合同 信息 管理 系统 共 包含 4 个 功能 模块 ， 即 用 户 登录 及 权限 管理 、 合 同 基本 信息 管理 、 
合同 收费 信息 管理 和 合同 资料 查询 与 导出 。 它 们 分 别 还 包含 自己 的 独立 子 功能 模块 ， 以 完成 
各 自 不 同 的 任务 。 该 系统 的 功能 模块 结构 图 如 图 11-1 所 示 。 


合同 信息 管理 系统 
合同 基本 信息 管理 | | 合同 收费 信息 管理 


用 户 登录 及 权限 管理 合同 资料 查询 与 导出 


合 
同 
基 
本 
信 
息 
查 
询 


对 疡 疗 玉 计 腊 到 只 
中 谅 泗 厅 讨 媒 可 路 
压 曙 汕 坦 本 悄 


染 穴 疗 神 溢 尝 可 吕 
绕 副 癌 六 溢 尝 忠 
区 岂 疗 神 溢 尝 到 吕 
芋 障 汪 苹 计 暴 可 路 
芋 崔 度 苹 竣 尝 可 路 


图 11-1 合同 信息 管理 系统 功能 模块 结构 图 
各 个 模块 的 功能 描述 如 下 。 
口 用 户 登 录 及 权限 管理 模块 ， 用 于 用 户 登录 、 修 改 用 户 名 或 修改 用 户 密码 。 
口 “合同 基本 信息 管理 模块 : 用 于 完成 对 合同 基本 信息 资料 的 添加 、 Ce 
操作 。 在 修改 和 删除 合同 基本 信息 资料 时 ， 首 先 需要 查询 出 要 修改 或 删除 的 合 
本 信息 。 
口 “合同 收费 信息 管理 模块 : 用 于 完成 对 合同 收费 信息 资料 的 添加 、 修 改 和 删除 等 基本 


办 公 应 用 非常 乞 比 - 
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操作 。 在 修改 和 删除 合同 收费 信息 资料 时 ， 首 先 需要 查询 出 要 修改 或 删除 的 合同 收 
费 信息 。 

口 合同 资料 查询 与 导出 模块 ， 用 于 完成 对 合同 基本 信息 资料 和 合同 收费 信息 资料 的 查 
询 和 导出 等 操作 。 查 询 出 的 结果 既 可 以 在 窗 体 上 浏览 查看 ， 也 可 以 将 查询 出 的 资料 
保存 到 一 个 新 工作 敌 中 ， 以 便于 进一步 进行 处 理 。 


11.1.1 知识 点 一 : 工作 表 的 可 见 性 


对 于 Excel 2007 文件 中 的 每 个 工作 表 都 有 一 个 可 见 性 属性 。 在 通常 情况 下 ， 新 建立 的 工 
作 表 的 可 见 性 属性 被 默认 设置 为 可 见 (-1-xlSheetVisible》。 该 属性 一 共有 3 个 可 设置 值 ， 分 
别 是 -1-xlSheetVisible、0-xlSheetHidden 和 1-xlSheetVeryHidden。 这 3 个 设置 值 的 意义 分 别 是 : 
口 xlSheetVisible: 工作 表 可 见 。 
口 xlSheetHidden: 工作 表 被 隐藏。 使 用 该 隐藏 方式 隐藏 的 工作 表 可 以 通过 菜单 取消 该 工 
作 表 的 隐藏 。 隐 藏 或 取消 隐藏 的 方法 见 知识 点 二 。 
口 xlSheetVeryHidden: 工作 表 被 深度 隐藏 。 使 用 该 隐藏 方式 隐藏 的 工作 表 只 能 在 VBE 
环境 中 取消 隐藏 。 
要 修改 工作 表 的 可 见 性 ， 既 可 以 在 Excel 2007 界面 上 修改 ， 也 可 以 在 VBE 编辑 环境 下 修 
改 ， 但 是 在 VBE 环境 下 才 可 以 设置 深度 隐藏 。 下 面 两 个 知识 点 分 别 介绍 各 自 的 操作 。 


11.1.2 ”知识 点 二 : 隐藏 或 取消 隐藏 表 


通过 菜单 方式 隐藏 和 取消 隐藏 表 的 方法 是 : 选择 【开始 】 菜 单 栏 ， 再 选择 单元 格 功能 块 
中 的 【格式 】 选 项 ， 在 【可 见 性 】 一 栏 选择 【隐藏 或 取消 隐藏 】 命 令 ， 将 会 展开 一 个 二 级 菜 
单 ， 该 菜单 如 图 11-2 所 示 。 该 图 中 【取消 隐藏 工作 表 】 显 示 为 灰色 不 可 用 状态 。 因 为 工作 短 
只 有 两 个 表 ， 一 个 表 的 可 见 性 被 设置 为 xlSheetVeryHidden， 该 表 不 是 普通 的 隐藏 表 。 而 
Excel 2007 工作 短 至 少 要 保证 一 个 表 不 被 隐藏 。 此 时 该 工作 短 的 隐藏 表 列 表 中 没有 隐藏 表 ， 所 
以 该 项 为 不 可 用 。 

选择 【隐藏 工作 表 】 选 项 时 ， 当 前 被 激活 的 工作 表 的 可 见 性 被 设置 为 xlSheetHidden。 当 
再 选择 【取消 隐藏 工作 表 】 选 项 时 ， 在 弹出 的 【取消 隐藏 】 对 话 框 中 会 看 到 所 有 当前 工作 短 
中 被 隐藏 的 工作 表 的 明细 列表 (如 图 11-3 所 示 ) 。 从 中 选择 需要 取消 隐藏 的 表 后 ， 单 击 【 确 
定 】 按 钮 即 可 取消 该 表 的 隐藏 。 


队 忘 行 B) 
隐 壹 列 (OO 
隐 志 工作 专 (G) 
取消 降 萤 行 (D) 
取消 隐 营 列 (U 


图 11-2 ”隐藏 或 取消 隐藏 二 级 菜单 图 11-3 【取消 隐藏 】 对 话 框 
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11.1.3 ”知识 点 三 :设置 或 取消 深度 隐藏 


设置 为 深度 隐藏 后， 该 隐藏 表 将 不 会 出 现在 【取消 隐藏 】 对 话 框 中 。 要 查看 这 样 的 表 的 
数据 或 格式 ， 只 有 进入 VBE 环境 ， 然 后 修改 该 表 的 可 见 性 属性 。 修 改 的 方法 如 下 : 

(1) 在 Excel 2007 界面 中 按 AlIttF11 组 合 键 进入 VBE 环境 。 

(2) 在 【工程 资源 管理 器 】 中 找到 该 深度 隐藏 的 表 ， 选 择 该 工作 表 。 此 时 属性 面板 中 显 
示 的 即 为 该 表 的 所 有 属性 。 

(3) 找到 Visible 属性 ， 将 该 属性 设置 为 -1-xlSheetVisible。 

(4) 设置 该 表 为 深度 隐藏 表 的 步骤 与 上 述 步骤 一 致 ， 只 是 步骤 (3) 设置 的 Visible 属性 
为 1-xlSheetVeryHidden。 

在 VBA 代码 中 也 可 以 对 工作 表 的 可 见 属性 进行 设置 .设置 工作 表 可 见 性 的 语法 格式 如 下 ， 
其 中 可 见 性 参数 值 即 为 知识 点 一 说 到 的 3 个 系统 变量 。 

工作 表 对 象 .visible= 可 见 性 参数 值 


11.1.4 ”知识 点 四 : 保护 工作 表 与 撤销 保护 


在 设计 工作 短 时 ， 设 计 者 可 能 希望 用 户 在 工作 表 中 只 能 执行 某 些 固定 的 操作 。 例 如 只 人 允 
许 用 户 选择 工作 表 中 的 单元 格 而 不 能 进行 任何 编辑 操作 ， 此 时 需要 使 用 工作 表 保 护 功 能 实现 。 

首先 激活 需要 保护 的 工作 表 ， 然 后 在 Excel 2007 菜单 中 依次 选择 【审阅 】I 【保护 工作 表 】 
命令 ， 此 时 会 打开 【保护 工作 表 】 对 话 框 (如 图 11-4 所 和 示 ) 。 此 处 可 以 设置 是 否 保护 工作 表 
及 锁定 的 单元 格 内 容 、 保 护 工作 表 的 密码 以 及 用 户 允 许 的 操作 。 设 置 完成 后 单 击 【 确 定 】 按 
钮 。 如 果 设 置 了 密码 ， 此 时 会 弹出 一 个 对 话 框 (如 图 11-5 所 示 ) 要求 重新 确认 密码 。 再 次 输 
入 密码 后 单 击 【 确 定 】 按 钮 即 可 。 


加 到 
太 保护 工 作 表 及 锁定 的 单元 格 内 容 蕊 ) 


图 11-4 【保护 工作 表 】 对 话 框 图 11-5 确认 保护 工作 表 密 码 


要 取消 工作 表 保 护 ， 只 需要 再 次 在 Excel 2007 中 依次 选择 相应 菜单 。 此 时 【保护 工作 表 】 
菜单 已 经 变 成 了 【撤销 工作 表 保 护 】 菜 单 。 选 择 该 菜单 ， 然 后 输入 保护 密码 即 可 解除 工作 表 
的 保护 状态 。 

保护 工作 表 与 撤销 保护 工作 表 也 可 以 通过 代码 实现 。 这 两 个 功能 分 别 使 用 工作 表 对 象 的 
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Protect 方法 和 UnProtect 方法 实现 。Protect 方法 的 参数 十 分 复杂 ， 这 里 不 再 列 出 其 语法 格式 。 
而 UnProtect 方法 只 接受 一 个 可 选 参数 Password， 该 参数 是 保护 工作 表 的 密码 。 


11.2 数据 表 设 计 


在 本 系统 中 大 部 分 数据 都 被 保存 到 了 Access 数据 库 文件 中 。 使 用 Access 2007 打开 本 系统 
的 数据 库 文件 “合同 管理 .mdb” 后 ， 可 以 找到 5 个 数据 表 。 它 们 分 别 是 部 门 信息 表 、 合 同 基 
本 信息 表 、 合 同类 别 信息 表 、 合 同 收费 信息 表 和 收费 类 别 表 。 这 些 表 的 功能 描述 如 下 : 
口 部 门 信息 表 ， 用 于 保存 企 * 业 签订 合同 的 部 门 名 称 。 
口 合同 基本 信息 表 #: 用 于 保存 合同 的 基本 信息 数据 。 
口 “合同 类 别 信息 表 : 保存 合同 类 别 信息 数据 。 该 信息 项 目 将 合同 的 性 质 大 致 做 了 划分 
比如 设计 合同 、 承 包 合同 、 销 售 合同 等 。 
口 合同 收费 信息 表 : 保存 合同 的 收费 信息 数据 。 
口 收费 关 别 表 : 保存 合同 收费 的 类 别 数据 。 该 信息 表 定 义 收费 的 性 质 ， 比 如 定金 、 预 
付款 多 等 。 
在 前 面 章节 的 实例 中 已 经 讲述 过 如 何在 Access 中 建立 表 以 及 设置 表 的 字段 结构 。 这 里 
只 将 数据 库 中 所 有 表 的 字段 信息 以 表格 的 形式 体现 出 来 。 读 者 在 设计 该 数据 库 时 ， 可 以 参考 
表 11-1~ 表 11-4 对 数据 库 表 的 字段 进行 设置 。 


表 11-1 部 门 信息 表 字 段 设计 


字段 名 称 段 长 是 否 允 许 为 空 
合同 号 20 否 
项 目 名 称 30 否 
委托 单位 50 否 
联系 人 10 否 
联系 电话 20 否 
签订 日 期 否 
签订 人 10 否 
签订 部 门 20 否 
合同 起 始 日 期 否 
合同 终止 日 期 否 
合同 金额 否 
合同 类 别 20 否 
备注 50 是 
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表 11-3 合同 类 别 信息 表 字段 设计 


字段 名 称 
合同 类 别 


字段 名 称 
合同 号 

收费 类 别 
收费 日 期 


部 
臣 
过 


区 | 鸣 | 列 | 列 苇 


11.3 首页 设计 


本 实例 通过 一 个 首页 界面 将 各 种 功能 串联 在 一 起 ， 通 过 首页 可 以 快速 访问 各 个 子 功能 模 
块 。 首 页 的 界面 被 放置 在 一 个 工作 表 中 。 当 工作 夭 开 启 时 ， 直 接 进 入 该 界面 。 


11.3.1 首页 界面 设计 


首页 的 界面 和 以 往 章节 的 首页 界面 风格 大 体 一 致 。 在 界面 里 包含 了 7 个 图 形 ， 其 中 最 外 
围 的 一 个 图 形 作 为 边框 ， 其 他 6 个 都 作为 按钮 ， 如 图 11-6 所 示 。 


合同 管理 演 统 


(mii 
(es) ee) 
(ee) 


图 11-6 合同 管理 系统 首页 界面 
建立 该 首页 界面 的 步骤 如 下 : 
(1) 在 Excel 2007 中 依次 选择 【插入 】|【 插 图 】| 【形状 】 命 令 。 然 后 在 矩形 形状 区 选择 
第 一 个 矩形 形状 。 随 后 在 首页 的 工作 区 中 单 击 鼠 标 并 拖 动 以 产生 适当 大 小 的 界面 外 边框 。 
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(2) 右 击 外 边框 ， 在 弹出 的 快捷 菜单 中 选择 【设置 形状 格式 】 命 令 ， 打 开 【 设置 形状 格 
式 】 对 话 框 。 在 该 对 话 框 中 选择 【阴影 】 选 项 并 在 【 预 设 】 下 拉 列 表 框 的 “外 部 ”分 类 中 选 
择 【 右 下 和 斜 偏 移 】 选 项 ， 设 置 效 果 如 图 11-7 所 示 。 然 后 选择 【文本 框 】 项 目 。 将 “文本 版 式 ” 
分 类 中 的 【垂直 对 齐 方式 】 设 置 为 【顶端 对 齐 】。 
(3) 选中 以 上 创建 的 外 边框 ， 随 后 依次 选择 【开始 】| 【字体 】 命 令 。 在 【字体 】 选 项 卡 
分 组 中 设置 字体 为 “华文 彩云 ”， 字 号 为 20。 设 置 效 果 如 图 11-8 所 示 。 再 次 右 击 该 外 边 
框 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 ， 然 后 输入 文字 内 容 为 “合同 管理 系统 ”。 


Ei 
4 | 阴影 
拭 条 靖 色 | 现 设 加 ， 站] 
吉 开 
)， 鲍 局 
| aml 
= 区 有 em， 一 丰 一 区 一 习 
三 准 旋 转 【| 大 小 @) 一 由 一 Fa 习 


图 片 | 
广 # 杠 “有 咱 区 -让 一 下 一 习 
距离 中 ) i—— ER 习 


图 11-7 设置 形状 阴影 图 11-8 文字 格式 设置 


(4) 和 前 面 插入 和 矩形 形状 操作 步骤 相似 ， 在 Excel 2007 中 依次 选择 【插入 】|【 插 图 】 | 
【 形状】 命令 。 然 后 选择 矩形 形状 区 域 第 二 个 图 形 一 一 圆 角 矩形 。 随 后 在 界面 外 边框 内 创建 
适当 大 小 的 圆 角 算 形 。 

(5) 右 击 该 圆 角 矩形， 在 弹出 的 快捷 菜单 中 选择 【设置 形状 格式 】 菜 单项 。 在 打开 的 
【设置 形状 格式 】 对 话 框 中 将 其 【阴影 】 设 秆 为 与 外 边框 一 致 。 然 后 选择 【填充 】 项 目 并 选 
中 【渐变 填充 】 单 选 按钮 ，【 类 型 】 选 择 【 线 性 】，【 颜 色 】 设 置 为 【橙黄 色 】。 设 置 的 效 
果 如 图 11-9 所 示 。 

(6) 将 步骤 (5) 创建 的 圆 角 和 矩形 复制 5 份 ， 调 整 好 各 个 圆 角 矩 形 间 的 间距 。 然 后 依次 
右 击 各 个 圆 角 矩形 ， 在 弹出 的 快捷 菜单 中 选择 【编辑 文字 】 命 令 。 设 置 文字 内 容 依次 为 “ 登 
录 系 统 ”、“ 修 改 用 户 名 ”、“ 修 改 密码 ”、“ 合 同 基本 信息 管理 ”、“ 合 同 收费 信息 管理 ” 
和 “合同 信息 查询 与 导出 ”。 

(7) 为 按钮 添加 宏 。 本 系统 的 首页 界面 上 的 按钮 被 单 击 后 将 开启 相应 的 窗口 ， 这 个 动作 
是 由 相应 的 宏 过 程 实现 的 ， 将 这 些 宏 指 定 到 相应 的 按钮 即 可 。 这 里 只 以 【登录 系统 】 按 钮 为 
例 加 以 说 明 。 首 先 右 击 该 按钮 ， 在 弹出 的 快捷 菜单 中 选择 【指定 宏 】 命 令 。 在 【指定 宏 】 窗 
口 的 列表 框 中 选择 【登录 系统 】 宏 过 程 ， 随 后 单 击 【 确 定 】 按 钮 即 可 。 效 果 如 图 11-10 所 示 。 
各 个 按钮 的 宏 代 码 请 见 后 续 代 码 设 计 章 节 。 


Ah 
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11.3.2 ”首页 代码 设计 


首页 按钮 的 宏 代 码 被 保存 在 “首页 按钮 的 宏 代码 ”模块 中 ， 打 开 该 模块 后 即 可 见 到 所 有 
宏 代 码 。 模 块 包含 了 6 个 过 程 ， 分 别 对 应 6 个 按钮 。 这 些 过 程 的 代码 大 致 一 致 ， 但 有 些 模块 
需要 检测 是 否 有 用 户 登 录 系 统 ， 只 有 用 户 登 录 后 才能 开启 相应 窗口 。 例 如 合同 基本 信息 管理 
合同 收费 信息 管理 、 合 同 信息 查询 与 导出 3 个 模块 ， 登 录 系统 、 修 改 用 户 名 和 修改 密码 中 都 
需要 输入 用 户 名 和 密码 ， 因 此 不 需要 用 户 登录 : 以 下 是 这 些 宏 的 详细 代码 解释 : 
Sub 基本 信息 () 


IflsLogin Then 检测 是 否 有 用 户 登录 系统 
合同 基本 信息 管理 .Show ' 显 示 合 同 基本 信息 管理 窗口 
Else 
MsgBox "你 还 没有 登录 系统 ! ", vblnformation + vbOKOnly ' 显 示 没有 用 户 登录 的 提示 信息 
End 上 
End Sub 


Sub 收费 信息 () 


IflsLogin Then 检测 是 否 有 用 户 登录 系统 
合同 收费 信息 管理 .Show ' 显 示 合 同 收费 信息 管理 窗口 
Else 
MsgBox "你 还 没有 登录 系统 ! ", vblnformation + vbOKOnly ' 显 示 没有 用 户 登录 的 提示 信息 
End If 
End Sub 


Sub 信息 查询 与 导出 () 


If lsLogin Then 检测 是 否 有 用 户 登录 系统 
合同 信息 查询 与 导出 .Show ' 显 示 合 同 信息 查询 与 导出 窗口 
Else 
MsgBox "你 还 没有 登录 系统 ! ", vblnformation + vbOKOnly ' 显 示 没 有 用 户 登录 的 提示 信息 
End If 
End Sub 
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Sub 用 户 名 () 
修改 用 户 名 .Show ' 显 示 修改 用 户 名 窗口 
End Sub 


Sub 密码 () 
修改 密码 .Show ' 显 示 修 改 密码 窗口 
End Sub 


Sub 登录 系统 () 
用 户 登录 .Show ' 显 示 用 户 登 录 窗 口 
End Sub 


11.4 模块 代码 设计 


在 窗口 代码 设计 中 使 用 到 了 部 分 公共 变量 及 公用 过 程 ， 这 些 公 共 变量 和 过 程 都 被 单独 保 
存在 模块 代码 中 。 为 了 便于 介绍 窗口 代码 设计 ， 这 里 首先 介绍 模块 代码 ， 以 便 读 者 阅读 后 续 
窗口 代码 。 

实例 包含 了 3 个 模块 ， 前 面 首页 代码 设计 部 分 已 经 讲述 了 “首页 按钮 的 宏 代 码 ” 模 块 代 
码 。 这 里 将 分 两 节 讲述 剩余 的 两 个 模块 : 公共 变量 模块 和 创建 数据 库 程序 模块 。 


11.4.1 公共 变量 模块 代码 设计 


公共 变量 模块 中 包含 了 程序 运行 中 使 用 到 的 所 有 公共 变量 ， 了 解 这 部 分 变量 的 作用 有 助 
于 理解 整个 系统 的 架构 和 代码 设计 方式 。 以 下 是 该 模块 包含 的 代码 : 


Public cnn As ADODB.Connection ' 公 用 数据 库 链 接 对 象 

Public rs As ADODB.Recordset ' 公 用 数据 记录 集 对 象 

Public myArray As Variant ' 自 定义 数组 ， 具 体 作用 在 后 续 代码 中 详细 介绍 
Public lsLogin As Boolean ' 确 认 当 前 是 否 有 用 户 登 录 系 统 


11.4.2 创建 数据 库 程序 模块 代码 设计 


香 
创建 数据 库 程序 模块 仅 包 含 了 一 个 过 程 : 创建 数据 


库 。 该 过 程 用 于 检测 数据 库 是 否 存在 , 当 数 据 库 不 存在 时 ， 
程序 通过 代码 建立 该 数据 库 以 及 各 个 表 的 结构 。 本 实例 是 
使 用 ADO 数据 库 对 象 实现 的 ， 读 者 也 可 以 对 照 前 面 使 用 
ADO 数据 库 对 象 的 建立 方法 。 在 实际 情况 中 ， 读 者 可 以 
自行 选择 一 种 方法 。 如 图 11-11 所 示 的 是 该 过 程 的 代码 执 
行 流程 。 

该 过 程 的 详细 代码 解释 如 下 所 示 : 


建立 合同 类 别 信 息 表 


图 11-11 创建 数据 库 过 程 流程 图 


of 
Es CE 1 人 人 
Public Sub 创建 数据 库 () 
Dim myCat As New ADOX.Catalog 
Dim myCmd As New ADODB.Command 
Dim mydata As String 
Dim SQL As String 
mydata = ThisWorkbook.Path & "合同 管理 .mdb" 数据 库 保存 位 置 
If Dir(mydata) = " Then "检查 数据 库 是 否 存在 
MsgBox "数据 库 一 合同 管理 .mdb> 不 存在 ! 下 面 将 创建 这 个 数据 库 ! "，_ 
vbExclamation,“ 创 建 数据 库 ” 
"创建 数据 库 文件 
myCat.Create "Provider=Microsoft. Jet.OLEDB.4.0;Data Source=" & mydata 
"设置 数据 库 连 接 
Set myCmd.ActiveConnection = myCat.ActiveConnection 
"创建 数据 表 “ 部 门 信息 ” 
SQL = "CREATE TABLE 部 门 信息 (部 门 名 称 text(20))" 
myCmd.CommandText = SQL 
myCmd.Execute ,, adCmdText 
"创建 数据 表 “ 合 同类 别 信息 ” 
SQL = "CREATE TABLE 合同 类 别 信息 (合同 类 别 text(20))" 
myCmd.CommandText = SQL 
myCmd.Execute ,, adCmdText 
' 创 建 数据 表 “ 收 费 类 别 信息 ” 
SQL = "CREATE TABLE 收费 类 别 信 息 (收费 类 别 text(20))" 
myCmd.CommandText = SQL 
myCmd.Execute ,, adCmdText 
' 创 建 数据 表 “ 合 同 基本 信息 ” 
SQL = "CREATE TABLE 合同 基本 信息 (合同 号 text(20), 项 目 名 称 text(30)," _ 
& "委托 单位 text(50), 联 系 人 text(10), 联 系 电话 text(20), 签 订 日 期 date," _ 
& "签订 人 text(10), 签 订 部 门 text(20)," _ 
& "合同 起 始 日 期 date, 合 同 终止 日 期 date, 合 同 金额 currency,”_ 
&" 合 同类 别 text(20), 备 注 text(50))" 
myCmd.CommandText = SQL 
myCmd.Execute ,, adCmdText 
' 创 建 数据 表 “ 合 同 收费 信息 ” 
SQL = "CREATE TABLE 合同 收费 信息 (合同 号 text(20), 收 费 类 别 text(20)," _ 
& "收费 日 期 date, 收 费 金 额 currency, 备 注 text(50))" 
myCmd.CommandText = SQL 
myCmd.Execute ,, adCmdText 
Set myCat = Nothing 
Set myCmd = Nothing 
"弹出 信息 
MsgBox "创建 数据 库 成 功 ! "& vbCrlLf _ 
& "数据 库 文件 名 为 : 合同 管理 .mdb" & vbCrlLf _ 
& "保存 位 置 :" & ThisWorkbook.Path, vblnformation, "创建 数据 库 " 
End If 
End Sub 
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11.5 用 户 登 录 窗 口 设计 


该 系统 打开 后 ， 会 立即 弹出 用 户 登录 窗口 。 用 户 可 以 退出 该 窗口 取消 登录 ， 但 在 首页 单 
击 【 用 户 登 录 】 按 钮 又 可 重新 开启 该 窗口 。 只 有 当 用 户 登录 系统 后 ， 才 可 以 完成 与 合同 相关 
的 所 有 操作 。 但 仍然 可 以 修改 用 户 名 以 及 密码 ， 可 以 在 不 登录 系统 时 进行 。 


11.5.1 用 户 登录 窗口 界面 设计 


用 户 登 录 窗 口 界面 十 分 简单 ， 包 含 的 控件 数量 很 少 ， 这 里 不 再 以 列表 形式 体现 控件 列表 
明细 。 窗 口 包含 了 2 个 标签 控件 、2 个 文本 框 控件 以 及 2 个 按 加 
钮 控件 。 标签 以 及 文本 框 分 为 两 组 , 分 别 用 于 用 户 名 和 用 户 密 Hpai[ Xa | 
码 的 提示 与 输入 工作 。 两 个 按钮 分 别 完成 确认 登录 与 关闭 窗口 | 
工作 。 如 图 11-12 所 示 是 该 窗口 的 界面 。 

建立 该 窗口 的 步骤 如 下 : 

(1) 在 VBE 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 建立 一 个 新 窗 体 。 在 属性 窗口 
中 将 该 新 窗 体 的 名 称 属 性 设置 为 “用 户 登 录 ”， 如 图 11-13 所 示 。 

(2) 在 工具 箱 中 选择 标签 控件 ， 在 窗 体 中 连续 插入 两 个 标签 。 在 属性 窗口 中 分 别 将 两 标 
签 控件 的 名 称 设 置 为 “用 户 名 : ”和 “密码 : ”， 如 图 11-14 所 示 。 


图 11-12 用户 登录 窗口 界面 


悍 性 -用户 登 录 | 
用户 村 姆 UserForm | 


图 11-13 用 户 登 录 窗 体 属性 设置 图 11-14 用 户 登录 窗 体 设计 效果 


(3) 在 工具 箱 中 选择 文本 框 控件 ， 在 窗 体 中 连续 插入 两 个 文本 框 。 在 属性 窗口 中 分 别 将 
两 文本 框 控 件 的 名 称 设置 为 TextBoxl 和 TextBox2。 

(4) 在 工具 箱 中 选择 按钮 控件 ， 在 窗 体 中 连续 插入 两 个 按钮 控件 。 在 属性 窗口 中 分 别 将 
两 按钮 的 名 称 设置 为 CommandButtonl 和 CommandButton2，Caption 属性 分 别 设置 为 “进入 系 
统 ” 和 “取消 退出 ”。 


11.5.2 ” 窗 体 代 码 设计 


窗 体 使 用 了 一 个 布尔 变量 IsLogin， 通 过 该 变量 程序 确认 是 否 有 用 户 已 经 登录 。 该 变量 的 
状态 决定 了 用 户 是 否 可 以 使 用 与 合同 相关 的 功能 。 但 用 户 仍然 可 以 进行 用 户 名 、 用 户 密码 修 
改 工作 。 因 为 在 这 些 修改 过 程 中 仍然 需要 用 户 输入 用 户 名 和 用 户 密码 。 


ff 
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窗口 包含 了 3 个 过 程 ， 分 别 是 窗口 初始 化 事件 、 确 认 按钮 单 击 事 件 、 关 闭 按钮 单 击 事件 。 
在 初始 化 事件 中 ， 过 程 完成 窗口 中 各 控件 的 状态 初始 化 任务 。 确 认 按钮 单 击 事件 检查 用 户 名 
是 否 存在 、 密 码 是 否 正确 以 及 登记 用 户 登 录 、 打 开 数 据 库 链 接 等 工作 。 关 闭 按钮 单 击 事件 
于 退出 系统 ， 关 闭 工 作 德 。 
在 窗口 初始 化 代码 中 不 要 设置 isLogin 公共 变量 的 值 为 False, 因为 可 能 已 经 有 用 户 登 录 成 
功 。 此 时 只 需要 保证 isLogin 的 值 不 变化 即 可 ， 以 防 造 成 混乱 。 窗 口 初始 化 事件 代码 如 下 : 


Private Sub UserForm_lnitialize() 


TextBox1 ="" ' 置 空 用 户 名 文本 框 

TextBox2 ="" ' 置 空 密码 文本 框 

TextBox1.SetFocus ' 将 焦点 定位 到 用 户 名 文本 杠 
End Sub 


确认 按钮 的 单 击 事件 代码 比较 繁杂 。 这 里 将 列 出 该 过 程 的 流程 图 ， 读 者 可 以 参照 该 图 理 
解 该 过 程 的 代码 。 该 过 程 的 流程 图 如 图 11-15 所 示 。 


图 11-15 登录 系统 窗口 流程 图 


Private Sub CommandButton1_Click() 
On Error GoTo errorhandle 


Dim ws As Worksheet 

Set ws = Worksheets(" 用 户 名 密码 ") 获得 用 户 名 密码 工作 表 对 象 

If TextBox1.Text = "" Then 检查 用 户 名 文本 框 是 否 为 空 
TextBox1.SetFocus ' 重 置 鼠标 焦点 到 用 户 名 文本 框 
Exit Sub 

End If 

If TextBox2.Text = "" Then 检查 密码 文本 框 是 否 为 空 
TextBox2.SetFocus ' 重 置 鼠标 焦点 到 密码 文本 框 
Exit Sub 

End 上 f 


' 循 环 对 比 用 户 名 密码 表 中 的 用 户 名 、 密 码 与 用 户 输入 用 户 名 、 密 码 
Fori = 2 To ws.Range("A65536").End(xIUp).Row 
Ifws.Range("A" & i).Text = TextBox1.Text _ 
And ws.Range("B" & i)Text = TextBox2.Text Then ”找到 对 应 用 户 名 与 密码 
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Unload 用 户 登 录 ' 退 出 窗口 

lsLogin = True "设置 登录 标识 为 真 

Call 创建 数据 库 "链接 数据 库 或 建立 数据 库 
Exit Sub 


Elself ws.Range("A" & i).Text = TextBox1.Text _ 
And ws.Range("B" & i)Text <> TextBox2.Text Then ”' 用 户 名 正确 但 密码 不 正确 


MsgBox "密码 错误 !", vbCritical, "警告 " ' 提 示 密 码 错 误 

TextBox2 = ™" ' 置 空 密码 文本 框 
TextBox2.SetFocus ' 将 鼠标 焦点 等 位 到 密码 文本 杠 
Exit Sub 


Elself ws.Range("A" & i).Text <> TextBox1.Text _ 
And ws.Range("B" & i)Text = TextBox2.Text Then ”' 用 户 名 不 正确 ， 密 码 正确 


MsgBox "用 户 名 错误 !", vbCritical, "警告 " 提示 用 户 名 错误 
TextBox1 = " ' 置 空 用 户 名 文本 框 
TextBox1.SetFocus ' 将 鼠标 焦点 定位 到 用 户 名 文本 框 
Exit Sub 
End If 
Nexti 
MsgBox "用 户 名 和 密码 不 存在 !", vbCritical, "警告 ' 提 示 用 户 名 和 密码 错误 
TextBox1 ="" 
TextBox2 = "" 
TextBox1.SetFocus 
Unload 用 户 登录 
errorhandle: 
ThisWorkbook.Close savechanges:=False ' 关 闭 工 作 簿 并 且 不 保存 
End Sub 


单 击 【 关 闭 】 按 钮 时 ， 完 成 的 工作 比较 简单 ， 只 需要 退出 系统 ， 并 且 不 保存 工作 敌 的 变 
化 。 以 下 是 该 按钮 单 击 事件 的 代码 : 
Private Sub CommandButton2_Click() 


ThisWorkbook.Close savechanges:=False 
End Sub 


11.6 修改 用 户 名 窗口 设计 


修改 用 户 名 窗口 用 于 修改 用 户 的 用 户 名 ， 该 窗口 可 以 直接 被 打开 ， 无 须 登录 系统 。 在 修 
改 用 户 名 过 程 中 ， 需 要 输入 正确 的 新 用 户 名 、 原 用 户 名 和 密码 方 可 修改 成 功 。 在 该 窗口 中 修 
改 用 户 名 将 不 会 造成 该 用 户 登录 系统 ， 并 且 当 前 用 户 修改 用 户 名 时 仍然 需要 输入 密码 。 


11.6.1 窗口 界面 设计 
该 窗 体 包含 了 比较 少 的 控件 ， 此 处 只 做 简要 的 文字 介绍 ， 不 再 用 表 列 明 控件 。 窗 体 共 包 


含 了 3 个 标签 控件 、3 个 文本 框 控件 以 及 2 个 按钮 控件 。1 个 标签 控件 对 应 1 个 文本 框 控件 。 
【确定 】 按 钮 用 于 确定 用 户 名 修改 , 【取消 】 按 钮 用 于 关闭 窗口 。 该 窗口 的 界面 如 图 11-16 所 


Aan00 
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创建 该 窗口 的 步骤 如 下 : 
(1) 在 VBE 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 建 立 一 个 新 窗 体 。 在 属性 窗口 
中 将 该 新 窗 体 的 名 称 属性 设置 为 “修改 用 户 名 ”， 如 图 11-17 所 示 。 


修改 用 户 各 到 


原 用 户 名 : 对 
新 用 户 各 : 
者 友 : I | 


[ame] mw | 


图 11-16 修改 用 户 名 窗口 界面 图 11-17 修改 用 户 名 窗 体 属性 设置 


(2) 在 工具 箱 中 选择 标签 控件 ， 在 窗 体 中 连续 插 
入 3 个 标签 。 在 属性 窗口 中 分 别 将 3 个 标签 控件 的 
Caption 属性 设置 为 “ 原 用 户 名 : ”、“ 新 用 户 名 : ” 
和 “密码 : ”， 如 图 11-18 所 示 。 

(3) 在 工具 箱 中 选择 文本 框 控件 ， 在 窗 体 中 连续 
插入 3 个 文本 框 ,在 属性 窗口 中 分 别 将 3 个 文本 框 控 件 
的 名 称 属 性 设置 为 TextBox1，TextBox2 和 TextBox3 。 

(4) 在 工具 箱 中 选择 按钮 控件 ， 在 窗 体 中 连续 插 
入 3 个 按钮 控件 。 在 属性 窗口 中 分 别 将 3 个 按钮 的 名 称 设置 为 CommandButton1 、 
CommandButton2 和 CommandButton3，Caption 属性 设置 为 “确定 ”和 “取消 ”。 


图 11-18 ”修改 用 户 名 窗 体 设计 效果 


11.6.2 ”窗口 代码 设计 


窗口 包含 的 事件 代码 不 多 ， 只 有 两 个 按钮 的 单 击 事件 代码 。 而 且 大 部 分 代码 集中 到 【 确 
定 】 按 钮 中 。 单 击 【确定 】 按 钮 时 ， 首 先 检测 该 用 户 是 否 存在 ， 然 后 确认 密码 是 否 正确 。 
当 用 户 名 和 密码 同时 正确 时 ， 程 序 将 在 用 户 名 密码 表 中 对 该 用 户 的 用 户 名 做 出 修改 并 保存 。 
图 11-19 列 出 了 该 按钮 单 击 事件 过 程 的 流程 图 。 


> 


ee 


部 


保存 工作 短 
退出 
11-19 修改 用 户 名 过 程 流程 图 
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Private Sub CommandButton1_Click() 
On Error GoTo errorhandle 
Dim ws As Worksheet, noExist As Boolean 


noExist = False "初始 化 noExist 变量 
Set ws = Worksheets(" 用 户 名 密码 ") ' 定 义 用 户 名 密码 表 对 象 
Fori = 2 To ws.Range("A65536").End(xIUp).Row "循环 检测 用 户 名 和 密码 
If ws.Range("A" &i).Text = TextBox1.Text Then 愉 测 用 户 名 是 否 正确 
If ws.Range("B" & i).Text = TextBox3.Text Then "检测 密码 是 否 正确 
ws.Unprotect Password:="123" ' 解 锁 工 作 表 
ws.Range("A" & i) = TextBox2.Text 路 改 用 户 名 
ws.Range("C" & i) = Now() ' 登 记 用 户 名 修改 时 间 
ws.Protect Password:="123" 锁定 工作 表 
TextBox1.Text = " ' 重 置 原 用 户 名 文本 框 
TextBox2.Text = "™" ' 重 置 新 用 户 名 文本 框 
TextBox3.Text = ™" ' 重 置 密码 文本 框 
MsgBox "用 户 名 修改 成 功 ! 请 记 好 您 的 新 用 户 名 ! "，_ "提示 用 户 名 修改 成 功 
vblnformation, "用 户 名 修改 成 功 " 
Unload 修改 用 户 名 
' 保 存 工作 简 
ThisWorkbook.Save 
Exit Sub "退出 过 程 
Else 
MsgBox "输入 密码 错误 ! ", vblnformation + vbOKOnly "提示 密码 错误 
TextBox3.Text = ™" ' 重 置 密码 文本 框 
TextBox3.SetFocus ' 将 鼠标 焦点 定位 到 密码 文本 杠 
End If 
Else 
noExist = True 标识 未 找到 该 用 户 名 
End If 
Nexti 


If noExist = True Then 
MsgBox "没有 用 户 名 " & TextBox1.Text &”!", vbCritical, "警告 " ”' 提 示 未 找到 用 户 时 


Unload 修改 用 户 名 ' 退 出 窗口 
End If 
errorhandle: 
If Err.Number <> 0 Then 
MsgBox "错误 ! "+ CStr(Err.Description), vbCritical, "错误 " "提示 错误 信息 
End If 
End Sub 


【取消 】 按 钮 的 代码 十 分 简单 ， 仅 仅 退出 窗口 即 可 。 下 面 代码 是 该 按钮 的 单 击 事件 代码 : 


Private Sub CommandButton2_Click() 
Unload 修改 用 户 名 
End Sub 


Excel VBA 应 用 开发 经 典 案例 了 汪汪 


_ 
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11.7 修改 密码 窗口 设计 


修改 密码 窗口 和 修改 用 户 名 窗口 的 结构 大 臻 类似。 该 窗口 也 可 以 被 直接 打开 ,无须 登 录 
系统 。 在 修改 密码 过 程 中 ， 需 要 输入 用 户 名 、 原 密码 以 及 新 密码 。 修 改 密码 也 不 会 造成 该 用 
户 登 录 系统 ， 用 户 只 有 在 用 户 登录 窗口 中 完成 登录 方 被 确认 登录 系统 。 


11.7.1 ”修改 密码 窗口 界面 设计 


修改 密码 窗口 的 界面 和 修改 用 户 名 的 窗口 界面 类 似 。 唯 一 的 
不 同 之 处 在 于 本 窗口 修改 的 对 象 是 用 户 密码 。 该 窗口 的 界面 效果 
图 如 图 11-20 所 示 。 该 窗口 包含 了 3 个 标签 控件 、3 个 文本 框 控 
件 以 及 2 个 按钮 控件 。1 个 标签 控件 和 1 个 文本 框 控件 相互 对 应 。 
创建 该 窗口 的 步骤 如 下 : 
(1) 在 VBE 环境 中 依次 选择 【插入 】|【 用 户 窗 体 】 命 令 。 图 11-20 修改 密码 窗口 界面 
建立 一 个 新 窗 体 。 在 属性 窗口 中 将 该 新 窗 体 的 名 称 属性 设置 为 “修改 密码 ”, 如 图 11-21 所 示 。 
(2) 在 工具 箱 中 选择 标签 控件 ， 在 窗 体 中 连续 插入 3 个 标签 。 在 属性 窗口 中 分 别 将 3 个 


标签 控件 的 Caption 属性 设置 为 “用 户 名 : ”、“ 原 密码 : ”和 “新 密码 : ”， 如 图 11-22 
本 
图 11-21 修改 密码 窗 体 属 性 设置 图 11-22 修改 密码 窗 体 设计 效果 


(3) 在 工具 箱 中 选择 文本 框 控件 ， 在 窗 体 中 连续 插入 3 个 文本 框 。 在 属性 窗口 中 分 别 将 
3 个 文本 框 控 件 的 名 称 设置 为 TextBox1，TextBox2 和 TextBox3。 

(4) 在 工具 箱 中 选择 按钮 控件 ， 在 窗 体 中 连续 插入 3 个 按钮 控件 。 在 属性 窗口 中 分 别 将 
3 个 按钮 的 名 称 设 置 为 CommandButton1、CommandButton2 和 CommandButton3，Caption 属 
性 设置 为 “确定 ”和 “取消 ”。 


11.7.2 ”窗口 代码 设计 


窗口 代码 包含 了 2 个 过 程 ， 分 别 是 【确认 】 按 钮 与 【取消 】 按 钮 的 单 击 事件 过 程 。【 确 
认 】 按 钮 被 单 击 时 ， 首 先 会 对 密码 进行 检测 ， 确 认 密 码 位 数 至 少 为 5 位 数 ， 然 后 在 用 户 名 密 
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缀 于。 Excel VBA 应 用 开发 经 典 案例 。 BE 


码 表 中 查找 该 用 户 名 及 对 应 的 密码 。 当 找到 该 用 户 名 且 密 码 正确 时 ， 程 序 将 修改 该 用 户 的 密 
码 为 新 密码 。 
Private Sub CommandButton1_Click() 
On Error GoTo errorhandle 
Dim ws As Worksheet, noExist As Boolean 
noExist = False 
Set ws = Worksheets(" 用 户 名 密码 ") 
If Len(TextBox2.Text) < 5 Then 
MsgBox "密码 位 数 最 少 不 能 小 于 5 位 !", vbCritical, "注意 " 
TextBox2.Text = "" 
TextBox3.Text = "" 
TextBox2.SetFocus 
Exit Sub 
End If 
Fori= 2 To ws.Range("A65536").End(xIUp).Row "循环 检测 用 户 名 和 密码 
If ws.Range("A" & i).Text = TextBox1.Text Then "检测 用 户 名 是 否 正确 
If ws.Range("B" & i).Text = TextBox2.Text Then ' 检 测 密码 是 否 正确 
ws.Unprotect Password:="123" ' 解 锁 工作 表 
ws.Range("A" & i) = TextBox3.Text 路 改 密码 
ws.Range("C" & i) = Now() 登记 用 户 名 修改 时 间 
ws.Protect Password:="123" 锁定 工作 表 
TextBox1.Text = "™" ' 重 和 置 原 用 户 名 文本 框 
TextBox2.Text = " ' 重 和 置 新 用 户 名 文本 框 
TextBox3.Text = "™" ' 重 和 置 密码 文本 框 
MsgBox "密码 修改 成 功 ! 请 记 好 您 的 新 密码 ! "，_ 提示 密 码 修改 成 功 
vblnformation, "用 户 名 修改 成 功 " 
Unload 修改 用 户 名 
' 保 存 工作 簿 
ThisWorkbook.Save 
Exit Sub "退出 过 程 
Else 
MsgBox "输入 密码 错误 ! ", vblnformation + vbOKOnly "提示 密码 错误 
TextBox2.Text = " ' 重 置 密码 文本 框 
TextBox2.SetFocus ' 将 鼠标 焦点 定位 到 密码 文本 框 
End If 
Else 
noExist = True 标识 未 找到 该 用 户 名 
End If 
Nexti 


If noExist = True Then 


MsgBox "没有 用 户 名 "& TextBox1.Text & "”! ", vbCritical, "警告 " 


Unload 修改 密码 
End 上 f 
errorhandle: 
If Err.Number <> 0 Then 


MsgBox "错误 ! "+ CStr(Err.Description), vbCritical, "错误 " 


End If 
End Sub 
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代码 说 明 : 
口 程序 中 对 密码 的 长 度 进行 了 限制 ， 必 须 保证 密码 长 度 在 5 位 以 上 。 当 密码 的 长 度 不 

能 达到 要 求 时 ， 程 序 将 把 密码 输入 框 置 空 ， 要 求 重 输 。 
口 ”循环 检测 用 户 名 和 密码 时 使 用 了 If 语句 的 嵌 套 结构 。 通 过 该 结构 的 双生 

户 名 输入 错误 和 密码 输入 错误 两 种 情况 。 
退出 该 窗口 时 ， 代 码 和 其 他 窗口 的 退出 代码 一 致 ， 仅 需要 使 用 Unload 命令 完成 窗口 的 卸 
载 工作 即 可 。 退 出 窗口 按钮 的 代码 如 下 : 


Private Sub CommandButton2_Click() 
Unload 修改 密码 
End Sub 


EE 判断 区 分 用 


11.8 合同 基本 信息 管理 窗口 设计 


在 合同 基本 信息 管理 窗口 中 可 以 完成 对 合同 基本 信息 资料 的 浏览 、 添 加 、 修 改 和 删除 等 
基本 操作 。 从 本 节 开 始 到 本 章 结束 ， 大 量 使 用 ADO 数据 库 对 象 操作 数据 库 文件 的 表 数 据 ， 读 
者 由 此 可 以 熟悉 ADO 数据 库 对 和 象 操作 数据 库 时 的 方法 。 


11.8.1 窗口 界面 设计 


该 窗口 控件 数量 繁多 ， 本 小 节 将 详细 讲述 该 窗口 包含 的 控件 和 建立 步 又。 本 窗口 的 界面 
如 图 11-23 所 示 。 


合同 基本 信息 管理 


一 合同 站 本 信息 
合同 呈 。 [CrooooiT SR 中 [RHS 同 ”=] 活 N 闫 别 | | 新 同 
项 目 名 称 | 邢 铀 300 包机 设 计 i 
委托 单位 弄 员 
联系 [压轴 联系 电话 5513-8888868 | 
E27] 入 部 门 | 大 一 训 9] Emsn || MM | 
舌 林 日 期 [005-5-23 ”合同 起 始 日 2005-9-23 合同 终止 日 008-9 25 
第 -条 
SNe [om ee ast 
E23 下 -条 
| 上 -条 
一 合同 惧 委 情 况 ER 
请 3 I 5 11 FE 3 一 一 
CADY00001 定金 2006-11-20 500000 
CADY00001 预付 款 2007-5-12 1000000 查询 
CADY00001 简 余 款 1 S00000 人 
4 | 
站 HE 目前 是 生 1 和 合同 对 


图 11-23 合同 基本 信息 管理 窗口 界面 


该 窗 体 一 共 包 含 了 2 个 框架 控件 、19 个 标签 控件 、13 个 文本 框 控件 、2 个 复合 框 控件 、 
12 按钮 控件 和 1 个 ListView 控件 。 表 11-5 列 出 了 控件 的 名 称 、 类 型 、 功 能 和 属性 设置 说 明 。 
限于 篇 幅 ， 列 表 不 再 对 标签 控件 做 介绍 ， 该 控件 只 需要 修改 对 应 的 Caption 属性 即 可 。 


办 公 应 用 意 党 之 狗 


Excel VBA 应 用 开发 经 典 案例 


表 11-5 合同 基本 信息 管理 窗口 控件 列表 
控 件 名 | 控件 类 型 控件 说 明 
nel 框架 控件 包含 了 建立 合同 时 所 有 的 基本 信息 输入 项 目 ， 该 框架 将 这 部 分 同类 控件 与 其 他 控 
件 区 分 开 来 。 该 控件 的 Caption 属性 被 设置 为 “合同 基本 信息 ” 
包含 了 ListView 控件 ， 该 部 分 用 于 显示 对 应 合同 的 所 有 收费 信息 。 该 控件 的 
Caption 属性 被 设置 为 “合同 收费 情况 ” 
合同 号 文本 框 该 文本 框 用 于 显示 或 设置 合同 
合同 类 别 复合 框 该 复合 框 用 于 显示 或 设置 合同 的 类 别 
添加 类 别 按钮 该 按钮 用 于 添加 新 合同 类 别 。 在 合同 类 别 复 合 框 中 输入 新 合同 类 别 后 ， 选 择 添加 
类 别 即 
项 目 名 称 文本 框 该 文本 框 用 于 显示 或 设置 项 目 名 称 
委托 单位 文本 框 该 文本 框 用 于 显示 或 设置 委托 单位 
联系 人 文本 框 该 文本 框 用 于 
联系 电话 文本 框 该 文本 框 用 于 
签订 人 文本 框 该 文本 框 用 于 显 和 人 
签订 部 门 复合 框 该 复合 框 用 于 显示 或 设置 签订 部 门 
添加 部 门 按钮 该 按钮 用 于 添加 新 部 门 。 在 部 门 复合 框 中 输入 新 部 门 后 ， 选 择 添加 部 门 即 可 
签订 日 期 文本 框 该 文本 框 用 于 显示 或 设置 签订 日 期 
合同 起 始 日 | 文本 框 该 文本 框 用 于 显示 或 设置 合同 起 始 日 期 
合同 终止 日 | 文本 框 该 文本 框 用 于 显示 或 设置 合同 终止 日 期 
合同 金额 文本 框 该 文本 框 用 于 显示 或 设置 合同 金额 


Frame2 框架 控件 


收费 合计 文本 框 该 文本 框 用 于 显示 或 设置 合同 收费 合计 
欠 费 合计 文本 框 该 文本 框 用 于 显示 或 设置 合同 欠 费 合计 
备注 文本 框 法 宇和 和 显示 或 设置 合同 备注 内 容 


ListViewl ListView “| 显示 当前 窗 体 上 所 显示 合同 的 详细 收费 情况 
新 合同 皮包 该 按钮 用 于 重 置 所 有 文本 框 和 复合 框 ， 以 便 输 入 新 合同 。ListView 控件 的 项 目 也 


将 被 清空 

添加 按钮 。 ”| 该 按钮 依据 在 窗口 中 输入 的 内 容 在 数据 库 中 建立 新 合同 
修改 术 钮 | 该 按钮 将 对 显示 在 窗口 中 的 当前 合同 基本 信息 进行 修改 
删除 护 丛 | 该 人 将 出 除 显示 在 窗口 中 的 当前 合同 本 信息 

第 -条 钮 。 | 将 当前 显示 的 合同 基本 信息 定位 到 第 一 

F 一 条 ”| 按钮 。 | 将 当前 显示 的 合同 基本 信息 定位 到 下 一 条 

上 一 条 安 钮 。 | 将 当前 显示 的 合同 此 本 信息 定位 到 上 一 条 

最 未 条 ”| 按钮 。 ”| 将 当前 显示 的 合同 基本 信息 定位 到 最 后 一 条 

查询 按钮 。 ”| 显示 符合 当前 合同 号 的 合同 基本 信息 

退出 按钮 。 | 退出 合同 基本 信息 管理 窗口 


创建 该 窗口 的 步骤 如 下 : 
(1) 在 VBE 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 建 立 一 个 新 窗 体 。 并 在 属性 窗 
口中 设置 该 窗 体 的 名 称 属 性 为 “合同 基本 信息 管理 ”， 如 图 11-24 所 示 。 
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(2) 在 工具 箱 中 选择 框架 控件 。 在 窗 体 上 插入 一 个 框架 ， 在 属性 窗口 中 修改 该 框架 的 
Caption 属性 为 “合同 基本 信息 ”， 名 称 修改 为 Framel1， 如 图 11-25 所 示 。 


[3 d 
[合同 于 本 信息 管理 VserForn 副 


图 11-24 合同 基本 信息 管理 窗 体 属性 设置 图 11-25 合同 基本 信息 框架 控件 属性 设置 
(3) 在 工具 箱 中 选择 标签 控件 ， 依 次 在 合同 基本 信息 框架 中 添加 15 个 标签 控件 。 然 后 
在 属性 窗口 中 分 别 设置 这 些 控件 的 Caption 属性 为 “合同 号 ”、“ 合 同类 别 ”、“ 项 目 名 称 ”、 
“委托 单位 ”、“ 联 系 人 ”、“ 联 系 电话 ”、“ 签 订 人 ”、“ 签 订 部 门 ”、“ 签 订 日 期 ”、 
“合同 起 始 日 ”、“ 合 同 终止 日 ”、“ 合 同 金额 ”、“ 收 费 合 计 ”、“ 欠 费 合 计 ” 和 “备注 ”， 
如 图 11-26 所 示 。 


-加 导 


图 11-26 合同 基本 信息 管理 窗 体 设计 效果 


(4) 在 工具 箱 中 选择 文本 框 控 件 ， 依 次 在 合同 基本 信息 框架 中 添加 13 个 文本 框 控 件 。 
然后 在 属性 窗口 中 分 别 设置 这 些 控 件 的 名 称 属 性 为 “合同 号 ”、“ 项 目 名 称 ”、“ 委 托 单位 ”、 
“联系 人 ”、“ 联 系 电 话 ”、“ 签 订 人 ”、“ 签 订 日 期 ”、“ 合 同 起 始 日 ”、“ 合 同 终止 日 ”、 
“合同 金额 ”、“ 收 费 合 计 ”、“ 欠 费 合计 ”和 “备注 ”，SelectionMargin 属性 都 设置 为 False， 
如 图 11-27 所 示 。 
(5) 在 工具 箱 中 选择 复合 框 控件 ， 依 次 在 合同 基本 信息 框架 中 添加 2 个 复合 框 控件 。 随 
后 在 属性 窗口 中 分 别 设置 这 些 控件 的 名 称 属性 为 :“ 合 同类 别 ”、“ 签 订 部 门 ”,， SelectionMargin 
属性 都 设置 为 False。 
(6) 在 工具 箱 中 选择 按钮 控件 ， 依 次 在 合同 基本 信息 框架 中 添加 2 个 按钮 控件 。 随 后 在 
属性 窗口 中 分 别 设置 两 个 按钮 控件 的 名 称 属性 为 “添加 类 别 ”、“ 添 加 部 门 ”。 


2O7 


(7) 调整 合同 基本 信息 框架 中 所 有 控件 的 大 小 与 位 置 ， 使 这 些 控件 的 大 小 与 位 置 与 如 
图 11-27 所 示 窗 口 相似 。 
(8) 在 工具 箱 中 选择 框架 控件 。 在 窗 体 上 插入 一 个 框架 。 随 后 在 属性 窗口 中 设置 该 框架 
的 Caption 属性 为 “合同 收费 情况 ”， 名 称 修改 为 Frame2， 如 图 11-28 所 示 。 
上 | 
广 ”: | 


图 11-27 设置 文本 框 的 SelectionMargin 属性 图 11-28 合同 收费 情况 框架 属性 设置 

(9) 选择 ListView 控件 ,在 合同 收费 情况 框架 中 插入 一 个 ListView 控件 。 随 后 在 属性 窗 
口中 设置 名 称 属性 设置 为 ListView1。 

(10) 在 合同 收费 情况 框架 的 下 方 插入 一 标签 控件 。 随 后 在 属性 窗口 中 设置 该 标签 控件 
的 Caption 属性 为 “合同 记录 数目 ”。 其 他 属性 默认 即 可 。 

(11) 在 工具 箱 中 选择 按钮 控件 。 在 窗 体 上 依次 插入 10 个 按钮 。 随 后 在 属性 窗口 中 设置 
这 些 按钮 的 Caption 属性 过 依次 为 “新 合同 ”、“ 添 加 ”、“ 修 改 ”、“ 删 除 ”、“ 第 一 条 ”、 
“下 一 条 ”、“ 上 一 条 ”、“ 最 末 条 ”、“ 查 询 ” 和 “退出 ”。 


11.8.2 ”窗口 初始 化 与 关闭 事件 代码 设计 


本 窗 体 的 代码 较 长 ， 下 面 将 分 不 同类 别 对 该 窗 体 的 代码 加 以 介绍 。 本 小 节 讲 述 的 是 该 窗 
体 的 初始 化 与 关闭 事件 代码 。 窗 口 初始 化 过 程 完成 的 工作 主要 是 设置 窗 体 控件 状态 、 链 接 数 
据 库 、 设 置 复合 框 、 显 示 合 同 基 本 信息 、 显 示 合同 收费 信息 。 如 图 11-29 显示 的 是 该 窗 体 初始 
化 过 程 的 流程 图 。 


建立 数据 库 链接 


设置 复合 框 项 目 
显示 合同 基本 信息 


显示 合同 收费 信息 


图 11-29 合同 基本 信息 管理 窗口 初始 化 过 程 流 程 图 


Private Sub UserForm_lnitialize() 
Dim mydata As String 
Dim i As Integer 
' 指 定数 据 库 


Ah 
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mydata = ThisWorkbook.Path & "\ 合 同 管理 .mdb" 

"设置 窗 体 控件 组 〈 也 是 数据 表 的 各 个 字段 组 ) 

myArray = Array(" 合 同 号 ", "项 目 名 称 ", "委托 单位 ", "联系 人 ", "联系 电话 "，_ 
"签订 日 期 ", "签订 人 ", "签订 部 门 ", "合同 起 始 日 ", "合同 终止 日 ，_ 
"合同 金额 ", "合同 类 别 ", "备注 ") 

"设置 窗 体 控件 的 背景 颜色 

Fori= 0 To UBound(myArray) 
Me.Controls(myArray(i)).BackColor = &HEOEOEO 

Next 

"设置 收费 合计 和 欠 费 合计 两 个 文本 框 及 其 对 应 标签 的 背景 颜色 和 可 操作 性 

收费 合计 .BackColor = &HEOEOE0 

欠 费 合计 .BackColor = &HE0E0E0 

收费 合计 .Enabled = False 

欠 费 合计 .Enabled = False 

收费 合计 标签 .Enabled = False 

欠 费 合计 标签 .Enabled = False 

"设置 合同 记录 数目 标签 的 背景 颜色 和 前 景 颜色 以 及 显示 效果 

合同 记录 数目 .SpecialEffect = fmSpecialEffectSunken 

合同 记录 数目 .ForeColor = &HC000C0 

合同 记录 数目 .BackColor = &HC0C0C0 

"建立 与 数据 库 的 连接 

Set cnn = New ADODB.Connection 

With cnn 
.Provider = "microsoftjet.oledb.4.0" 
.Open mydata 

End With 

"调用 子 程序 ， 为 合同 类 别 复 合 框 设置 项 目 

Call 合同 类 别 复合 框 设 置 

"调用 子 程序 ， 为 签订 部 门 复合 框 设置 项 目 

Call 签订 部 门 复合 框 设置 

' 调 用 子 程序 ,查询 合同 基本 信息 

Call 查询 合同 基本 信息 

' 调 用 子 程序 ,显示 合同 基本 信息 

Call 显示 合同 基本 信息 

' 调 用 子 程序 ,显示 某 合 同 的 收费 信息 

Call 显示 合同 收费 情况 

End Sub 


代码 说 明 : 

口 在 窗口 初始 化 过 程 中 ， 包 含 了 对 3 类 控件 的 状态 设置 。 这 些 控件 包括 文本 框 和 复合 
框 、 按 钮 、 标 签 。 在 设置 文本 框 和 复合 框 时 ， 使 用 了 一 个 数组 保存 了 这 些 文本 框 和 
复合 框 的 名 称 , 然后 使 用 一 个 For 循环 访问 这 些 控件 , 并 修改 相应 的 BackColor 属性 。 
访问 这 些 控件 时 ， 使 用 窗口 的 Controls 集合 。 当 控件 数量 众多 ， 且 设置 的 属性 大 致 相 
当时 ， 可 以 采用 这 样 的 方式 精简 代码 。 

口 “在 初始 化 过 程 中 ， 涉 及 到 的 自 定义 过 程 将 在 后 续 相 应 小 节 单独 加 以 介绍 。 这 些 过 程 
包括 合同 类 别 复 合 框 设置 、 签 订 部 门 复合 框 设 置 、 查 询 合同 基本 信息 、 显 示 合同 基 
本 信息 、 显 示 合 同 收费 情况 5 个 自 定义 过 程 。 


用 户 单 击 【退出 】 按 钮 时 ， 将 会 关闭 本 窗 体 。【 退 出 】 按 钮 代码 十 分 简单 ， 以 下 是 该 按 
钮 的 代码 。 


Private Sub 退出 _Click() 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
Unload 合同 基本 信息 管理 
End Sub 


11.8.3 ”复合 框 设 置 过 程 代码 设计 


在 合同 基本 信息 框架 中 包含 了 两 个 复合 框 : 窗口 合同 类 别 和 签订 部 门 复合 框 。 初 始 化 代 
码 中 这 两 个 复合 框 的 设置 过 程 分 别 用 于 初始 化 合同 类 别 、 签 订 部 门 复合 框 项 目 。 首 先 从 数据 
库 中 获取 合同 类 别 、 签 订 部 门 记录 集 ， 然 后 将 这 些 合同 类 别 、 签 订 部 门 记录 数据 依次 写 入 合 
同类 别 复合 框 中 。 以 下 是 这 两 个 自 定义 过 程 的 详细 代码 : 


Public Sub 合同 类 别 复 合 框 设 置 () 
Dim rsx As New ADODB.Recordset 


Dim i As Integer 
"获取 合同 类 别 记 录 集 
rsx.Open "合同 类 别 信息 " cnn, adOpenKeyset, adLockOptimistic 
With 合同 类 别 
.Clear "清空 合同 类 别 复合 杠 
Fori= 1To rsx.RecordCount 
.Addltem rsx.Fields(0) "将 合同 类 别 记 录 数 据 写 入 合同 类 别 复 合 框 中 
rsx.MoveNext ' 将 当前 记录 移 到 下 一 条 
Next 
End With 
rsx.Close "关闭 记录 集 
Set rsx = Nothing "清空 记录 集 对 象 占用 内 存 空 间 
End Sub 


Public Sub 签订 部 门 复合 框 设置 () 
Dim rsx As New ADODB.Recordset 


Dim i As Integer 
"获取 部 门 信息 记录 集 
rsx.Open "部 门 信息 ", cnn, adOpenKeyset, adLockOptimistic 
With 签订 部 门 
.Clear "清空 签订 部 门 复合 框 
Fori= 1 To rsx.RecordCount 
.Addltem rsx.Fields(0) 将 签订 部 门 记录 数据 写 入 签订 部 门 复合 框 中 
rsx.MoveNext ' 将 当前 记录 移 到 下 一 条 
Next i 
End With 
rsx.Close "关闭 记录 集 
Set rsx = Nothing "清空 记录 集 对 象 占用 的 内 存 空间 
End Sub 
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11.8.4 查询 、 显 示 合 同 基 本 信息 过 程 代 码 设计 


窗口 初始 化 时 ， 需 要 在 合同 基本 信息 框架 中 显示 一 合同 的 基本 信息 。 该 任务 由 查询 、 显 
示 合 同 基本 信息 两 个 过 程 共同 完成 。 查 询 合同 基本 信息 过 程 从 数据 库 中 获取 合同 基本 信息 记 
录 集 , 将 该 记录 集 保存 在 rs 公共 变量 中 。 显示 合同 基本 信息 过 程 首先 检测 rs 记录 集 是 否 为 空 ， 
当 为 空 时 ， 程 序 将 新 建 一 个 合同 ， 否 则 将 把 该 合同 的 基本 信息 写 入 合同 基本 信息 框架 中 的 控 
件 。 显 示 合同 基本 信息 过 程 稍微 显得 复杂 ， 如 图 11-30 所 示 的 是 该 过 程 的 流程 图 。 


图 11-30 显示 合同 基本 信息 过 程 流程 图 
以 下 是 这 两 个 过 程 的 详细 代码 : 
Public Sub 查询 合同 基本 信息 () 
Set rs = New ADODB.Recordset 
"获取 合同 基本 信息 记录 集 
rs.Open "合同 基本 信息 ", cnn, adOpenKeyset, adLockOptimistic 
End Sub 


Public Sub 显示 合同 基本 信息 () 
On Error Resume Next 
Dim i As Integer 
' 检 测 rs 记录 集 是 否 为 空 
Ifrs.BOF And rs.EOF Then 
Call 新 合同 _Click 新 建 合同 
Else 
"向 合同 基本 信息 框架 的 控件 填充 记录 集中 的 数据 
Fori=0ToUBound(myArray) 
If IsNull(rs.Fields(i)) Then 
Me.Controls(myArray(i)).Value = "" 
Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) 
End If 
Next 


' 查 询 该 合同 的 收费 合计 和 欠 费 合计 

Dim rsx As New ADODB.Recordset 

SQL = "select sum( 收 费 金额 ) as aa from 合同 收费 信息 "_ 
&" where 合同 号 =" & 合同 号 .Value & "" 


rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
' 在 窗 体 上 显示 该 合同 的 收费 合计 数据 和 欠 费 合计 数据 
IflsNull(rsxlaa) Then 
收费 合计 .Value = 0 
Else 
收费 合计 .Value = rsxlaa 
End If 
lf lsNull(rs.Fields(" 合 同 金额 ")) Then 
欠 费 合计 .Value = 0 
Else 
欠 费 合计 .Value = rs.Fields(" 合 同 金额 ") -Val( 收 费 合计 .Value) 
End If 
' 在 窗 体 下 面 的 标签 中 显示 数据 库 中 的 合同 记录 总 数 ， 以 及 当前 正在 显示 第 几 条 记录 
合同 记录 数目 .Caption = "数据 库 中 共有 “" & rs.RecordCount & "条 合同 记录 " _ 
& Space(5) & "目前 是 第 " & rs.AbsolutePosition & " 条 合同 记录 " 
rsx.Close 
Set rsx = Nothing 
End ff 
End Sub 


11.8.5 ”显示 合同 收费 情况 过 程 代码 设计 


合同 收费 情况 框架 中 的 ListView 控件 显示 了 所 有 当前 合同 的 收费 情况 ， 这 些 收费 情况 的 


数据 是 从 数据 库 中 获得 的 。 显 示 合同 收费 情况 过 程 完成 
的 即 为 该 部 分 任务 。 该 过 程 首先 从 数据 库 中 获取 一 记录 
集 ， 此 记录 集 的 合同 号 为 当前 显示 合同 的 合同 号 ,然后 
过 程 对 ListView 控件 做 了 显示 前 的 必要 设置 , 最 后 将 记 
录 集 中 的 数据 写 入 到 ListView 控件 中 。 如 图 11-31 所 示 
的 是 该 过 程 的 流程 图 。 


获取 满足 指定 
条 件 的 记录 集 
设置 ListView 控 件 


件 写 入 数据 


以 下 是 该 过 程 的 详细 代码 : 图 11-31 显示 合同 收费 情况 过 程 流程 图 


Public Sub 显示 合同 收费 情况 () 

On Error Resume Next 

Dim i As Integer 

Dim SQL As String 

Dim rsx As New ADODB.Recordset 

"获取 记录 集 ， 该 记录 集 的 合同 号 为 当前 显示 合同 的 合同 号 

SQL = "select * from 合同 收费 信息 where 合同 号 =" & 合同 号 .Value & "" 

rsx.Open SQL, cnn, adOpenKeyset adLockOptimistic 

With ListView1 
"设置 ListView1 的 标题 、 显 示 类 型 、 整 行 选择 和 网 格 线 属性 
.ColumnHeaders.Clear "清除 标题 
.Listltems.Clear "清除 显示 数据 
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.View = IvwReport ' 设 置 控件 显示 类 型 
.FullRowSelect = True ' 允 许 整 行 选择 
.Gridlines = True ' 网 格 线 


为 ListView1 设置 标题 
Fori = 0 To rsx.Fields.Count -1 


.ColumnHeaders.Add , , rsx.Fields(i).Name "添加 标题 
Next 
为 ListView1 设置 各 行 数据 
Fori= 1 To rsx.RecordCount 
.Listltems.Add , , rsx.Fields(0).Value 为 ListView 控件 增加 新 显示 项 


Forj = 1 To rsx.Fields.Count -1 
.Listltems(i).Subltems(j) = rsx.Fields(j).Value 为 新 增加 项 添加 子 项 
Next 
rsx.MoveNext 将 记录 集 指针 移 到 下 一 条 
Next 

End With 

rsx.Close 

Set rsx = Nothing 

End Sub 


11.8.6 ”添加 类 别 与 部 门 按钮 代码 设计 


合同 基本 信息 框架 包含 了 合同 类 别 和 签订 部 门 两 个 复合 框 控件 .复合 框 在 窗口 初始 化 时 被 
设置 了 项 目 值 。 用 户 还 可 以 通过 该 窗口 创建 新 合同 类 别 和 新 签订 部 门 。【 添 加 类 别 】 按 钮 与 【 添 
加 部 门 】 按 钮 分 别 实现 各 自 的 添加 功能 。 两 按钮 的 代码 十 分 相似 ， 这 里 将 这 两 个 按钮 的 单 击 
事件 代码 设计 放置 在 一 起 讲述 。 下 面 以 添加 类 别 为 例 ， 添 加 部 门 按钮 的 过 程 见 括号 提示 。 

单 击 【 添 加 类 别 】 按 钮 〈【 添 加 部 门 】 按 钮 》 后 ， 程 序 检测 新 合同 类 别 〈 新 部 门 ) 输入 
是 否 为 室 。 当 不 为 空 时 ， 程 序 才 继续 执行 ， 否 则 退出 添加 过 程 。 然 后 程序 检测 合同 类 别 信息 
表 《 部 门 信息 表 ) 是 否 已 经 包含 当前 新 类 别 〈 新 部 门 ) ， 当 不 包含 新 类 别 〈 新 部 门 ) 时 ， 程 
序 将 该 新 类 别 ( 新 部 门 ) 写 入 合同 类 别 信息 表 (部门 信息 表 )〉 中 。 所 有 的 写 入 操作 完成 后 ， 
程序 重新 设置 合同 类 别 〈 签 订 部 门 ) 复合 框 项目 值 ， 并 将 复合 框 的 显示 值 设置 为 新 类 别 〈 新 
部 门 ) 。 图 11-32 显示 的 是 【添加 类 别 】 按 钮 单 击 事件 过 程 流程 图 。 


一 牟 到 同 类 别 输入 不 为 守 
一 吾 同 买 别 信息 表 不 包 全 新 夹 别 7 一 一 下 
新 关 别 写 入 类 别 信息 表 
重 轩 合同 类 别 复合 杠 


图 11-32 【添加 类 别 】 按 钮 单 击 事件 过 程 流程 图 


【添加 部 门 】 按钮 的 单 击 事件 过 程 流程 图 可 以 参照 图 11-32， 只 需要 将 合同 类 别 换 为 部 门 


即 可 。 以 下 是 两 按钮 的 详细 单 击 事件 代码 : 


212 


Private Sub 添加 类 别 _Click() 


Dim lb As String 

lb = 合同 类 别 .Value "获取 新 输入 的 合同 类 别 

上 fLen(Trim(lb)) = 0 Then 
MsgBox "没有 输入 合同 类 别名 称 ! 不 能 添加 !", vbCritical, "警告 " "提示 新 合同 类 别 为 空 
Exit Sub 

End 上 f 

Dim rsx As New ADODB.Recordset 

Dim SQL As String 

SQL = "select * from 合同 类 别 信息 where 合同 类 别 =" & lb & "" 

rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 获取 合同 类 别 和 新 类 别 相等 的 记录 集 


If rsx.BOF And rsx.EOF Then ' 当 记录 集 为 空 时 ， 添 加 新 类 别 
rsx.AddNew "记录 集 添加 新 记录 
rsx.Fields(0) = lb 为 新 记录 赋值 
rsx.Update "更 新 记录 集 
MsgBox "添加 完毕 ! ", vblnformation, "添加 合同 类 别 " ' 提 示 添 加 成 功 

Else 


MsgBox "已 经 存在 了 同名 的 合同 类 别名 称 ! " vbCritical, "警告 ” ' 提 示 新 合同 类 别 已 经 存在 
End If 


rsx.Close ' 关 闭 记录 集 
Set rsx = Nothing ' 清 除 记录 集 对 象 占用 内 存 
Call 合同 类 别 复合 框 设置 ' 重 置 合同 类 别 复合 框 
合同 类 别 .Value = Ib ' 设 置 合同 类 别 复合 框 显示 值 


End Sub 


Private Sub 添加 部 门 _Click() 


Dim bm As String 

bm = 签订 部 门 .Value "获取 新 输入 的 签订 部 门 

If Len(Trim(bm)) = 0 Then 
MsgBox "没有 输入 签订 部 门 名 称 ! 不 能 添加 ! " vbCritical, "警告 ” “提示 新 签订 部 门 为 空 
Exit Sub 

End 上 f 

Dim rsx As New ADODB.Recordset 

Dim SQL As String 

SQL = "select * from 部 门 信 息 where 部 门 名 称 =" & bm & " 

rsx.Open SQL, cnn, adOpenKeyset adLockOptimistic ”获取 部 门 名 称 与 新 签订 部 门 相 等 的 记 


录 集 
If rsx.BOF And rsx.EOF Then ' 当 记录 集 为 空 时 ， 添 加 新 部 门 
rsx.AddNew "记录 集 添 加 新 记录 
rsx.Fields(0) = bm 为 新 记录 赋值 
rsx.Update "更 新 记录 集 


MsgBox "添加 完毕 ! ", vblnformation, "添加 部 门 " "提示 添加 部 门 成 功 
Else 
MsgBox "已 经 存在 了 同名 的 部 门 ! ", vbCritical, "警告 ”' 提 示 新 部 门 已 经 存在 
End If 
rsx.Close ' 关 闭 记录 集 
Set rsx = Nothing ' 清 除 记录 集 对 象 占用 内 存 
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Call 签订 部 门 复合 框 设 置 ' 重 置 签订 部 门 复合 框 
签订 部 门 .Value = bm "设置 签订 部 门 复合 框 显示 值 
End Sub 


11.8.7 ”新 合同 与 添加 按钮 代码 设计 


在 合同 基本 信息 管理 窗口 中 可 以 添加 新 合同 ， 单 击 【 新 合同 】 按 钮 与 【添加 】 按 钮 即 可 。 
单 击 【 新 合同 】 按 钮 后 ， 窗 口中 各 个 控件 的 数据 被 清除 ， 以 便 用 户 输入 新 合同 的 基本 信息 。 
当 用 户 输入 完 所 有 的 新 合同 基本 信息 后 ， 单 击 【 添 加 】 按 钮 后 ， 该 新 合同 基本 信息 将 被 添加 
进 数据 库 。 下 面 是 【新 合同 】 按 钮 的 单 击 事件 代码 : 

Private Sub 新 合同 _Click() 

Dim i As Integer 


"清除 窗 体 上 各 个 控件 的 数据 ， 或 将 某 控 件 的 值 设 置 为 默认 状态 
Fori=0ToUBound(myArray) 


Me.Controls(myArray(i)).Value = ™" ' 清 除 控件 数据 

Next 
合同 类 别 .ListIndex = 0 "设置 合同 类 别 复合 框 的 值 为 默认 
签订 部 门 .ListIndex = 0 "设置 签订 部 门 复合 框 的 值 为 默认 
签订 日 期 .Value = Format(Date, "yyyy-mm-dd") "设置 签订 日 期 文本 框 的 值 
收费 合计 .Value ="" ' 清 除 收费 合计 文本 框 数据 
欠 费 合计 .Value = ' 清 除 欠 费 合计 文本 框 数据 
ListView1.Listltems.Clear ' 清 除 ListView 控件 显示 项 
合同 记录 数目 .Caption = "数据 库 中 共有 “" & rs.RecordCount & " 条 合同 记录 " ”' 设 置 提示 标签 
合同 号 .SetFocus ' 将 光标 定位 到 合同 号 文本 框 

End Sub 


【添加 】 按 钮 完成 的 主要 任务 是 将 窗口 中 输入 的 新 合同 基本 信息 保存 到 数据 库 。 在 完成 
该 任务 过 程 中 ， 程 序 还 需要 检测 用 户 是 否 输入 了 必要 的 数据 、 检 测 合同 号 是 否 有 重复 。 新 合 
同 基本 信息 保存 完毕 后 ， 还 需要 重新 调用 查询 、 显 示 合 同 基本 信息 过 程 ， 更 新 窗口 显示 及 提 
示 。 图 11-33 显示 的 是 该 按钮 的 单 击 事件 过 程 流程 图 。 


图 11-33 【添加 】 按钮 单 击 事件 过 程 流程 图 


Aa15 


办 公 应 用 闫 党 之 多 


Exce| VBA 应 用 开发 经 典 案例 。 于 | En 


以 下 是 【添加 】 按 钮 的 单 击 事件 过 程 代码 : 
Private Sub 添加 _Click() 


Dim i As Integer 
"判断 是 否 在 窗 体 上 输入 了 必要 的 合同 数据 
Fori=0ToUBound(myArray) -1 
上 Me.Controls(myArray(i)).Name <> "备注 " Then 
If Me.Controls(myArray(i)).Value = " Then 
MsgBox Me.Controls(myArray(i)).Name & "不 能 为 空 ! ", vbCritical 
Me.Controls(myArray(i)).SetFocus 
Exit Sub 
End If 
End If 
Next 
上 MsgBox(" 本 操作 将 添加 新 的 合同 记录 !" & vbCrLf & "是 否 要 添加 ? "，_ 
vbQuestion + VbYesNo, "添加 记录 ") = vbNo Then Exit Sub 
' 首 先 判断 在 数据 库 中 是 否 存在 相同 的 合同 号 
Dim rsNum As New ADODB.Recordset 
SQL = "select 合同 号 from 合同 基本 信息 where 合同 号 =" & 合同 号 .Value & "" 
rsNum.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
If rsNum.RecordCount > 0 Then 
MsgBox "在 数据 库 中 已 经 存在 有 编号 为 <" & 合同 号 .Value & "> 的 合同 ! "_ 
& vbCrLf & "请 重新 输入 合同 号 ! ", vbOKOnly + vbCritical, "警告 " 


Me. 合 同 号 .Value = ' 将 合同 号 文本 框 数 据 清除 
Me. 合 同 号 .SetFocus ' 将 焦点 移 到 合同 号 文字 框 
GoTo hhh 

End If 

"准备 将 窗 体 上 的 数据 添加 到 数据 库 中 


SQL = "select * from 合同 基本 信息 " 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
"开始 添加 数据 
With rs 
.AddNew ' 添 加 各 个 字段 的 数据 
Fori= 0 To UBound(myArray) 
lf Me.Controls(myArray(i)).Name = "签订 日 期 " _ 
Or Me.Controls(myArray(i)).Name = "合同 起 始 日 "__ 
Or Me.Controls(myArray(i)).Name = "合同 终止 日 "Then 
.Fields(i) = Format(Me.Controls(myArray(i)).Value, "yyyy-mm-dd") 


Else 
.Fields(i) = Me.Controls(myArray(i)).Value 
End If 
Nexti 
.Update 更 新 数据 表 
End With 


MsgBox "已 经 成 功 将 新 合同 数据 添加 到 数据 库 中 !", vblnformation, "添加 记录 " 
' 刷 新 查询 

Call 查询 合同 基本 信息 

Call 显示 合同 基本 信息 


ff 
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hhh: 

rsNum.Close 

Set rsNum = Nothing 
End Sub 


11.8.8 修改 按钮 代码 设计 


【修改 】 按 钮 完成 对 当前 显示 合同 的 基本 信息 进行 修改 的 任务 。 当 用 户 需要 修改 合同 基 
本 信息 时 ， 在 合同 基本 信息 框架 中 修改 好 合同 的 基本 信息 后 ， 单 击 该 按钮 即 可 。 单 击 【修改 】 
按钮 后 ， 程 序 首先 提示 是 否 修改 ， 再 单 击 【确定 】 按 钮 后 ， 程 序 从 数据 库 获取 一 记录 集 。 该 
记录 集 的 合同 号 即 为 当前 显示 合同 的 合同 号 。 然 后 程序 将 用 户 对 合同 做 出 的 修改 保存 到 数据 
库 中 ， 并 更 新 记录 集 以 确认 修改 。 最 后 程序 调用 查询 与 显示 合同 基本 信息 刷新 查询 。 


Private Sub 修改 _Click() 
lf MsgBox(" 本 操作 将 修改 合同 号 为 <" & 合同 号 .Value & "> 的 合同 记录 ! "_ 
& vbCrLf & "是 否 要 更 新 ? "，_ 
vbQuestion + vbYesNo, "更 新 记录 ") = vbNo Then Exit Sub 
Dim i As Integer 
"准备 修改 记录 
SQL = "select * from 合同 基本 信息 where 合同 号 =" & 合同 号 .Value & "" 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
"修改 更 新 记录 
With rs 
Fori=0ToUBound(myArray) 
和 Me.Controls(myArray(i)).Name = "签订 日 期 "_ 
Or Me.Controls(myArray(i)).Name = "合同 起 始 日 " _ 
Or Me.Controls(myArray(i)).Name = "合同 终止 日 "Then 
.Fields(i) = Format(Me.Controls(myArray(i)).Value, "yyyy-mm-dd") 
Else 
.Fields(i) = Me.Controls(myArray(i)).Value 
End If 
Next i 
.Update ”更 新 数据 表 
End With 
MsgBox "已 经 成 功 将 编号 为 <" & 合同 号 .Value & "> 的 合同 记录 进行 了 更 新 ! "，_ 
vblnformation, "更 新 记录 " 
' 刷 新 查询 
Call 查询 合同 基本 信息 
Call 显示 合同 基本 信息 
End Sub 


11.8.9 删除 按钮 代码 设计 


【删除 】 按 钮 完成 删除 当前 显示 合同 基本 信息 记录 与 合同 收费 信息 的 任务 。 用 户 需要 删 
除 当前 合同 基本 信息 与 合同 收费 信息 时 ， 只 需 单 击 该 按钮 即 可 删除 当前 记录 。 单 击 【删除 】 
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按钮 后 , 程序 提示 是 否 删除 当前 显示 合同 记录 。 确 认 后 , 程序 调用 ADO 数据 库 对 象 的 Execute 


方法 执行 两 条 删除 记录 的 SQL 语句 ， 分 别 用 于 删除 合同 基本 信息 和 合同 收费 信息 。 最 后 程序 
调用 查询 、 显 示 合 同 基 本 信息 和 显示 合同 收费 情况 刷新 查询 。 以 下 是 该 按钮 的 单 击 事件 代码 : 
Private Sub 删除 _Click() 
If MsgBox(" 本 操作 将 删除 编号 为 <" & 合同 号 .Value & "> 的 合同 记录 ! "_ 
& vbCrLf & "是 否 要 删除 ? "，_ 
vbQuestion + vbYesNo, "删除 记录 ") = vbNo Then Exit Sub 
"删除 合同 基本 信息 
SQL = "delete from 合同 基本 信息 where 合同 号 =" & 合同 号 .Value & "" 
Set rs = cnn.Execute(SQL) 
"删除 合同 收费 信息 
SQL = "delete from 合同 收费 信息 where 合同 号 =" & 合同 号 .Value &"" 
Set rs = cnn.Execute(SQL) 
MsgBox "已 经 成 功 将 编号 为 <" & 合同 号 .Value & "> 的 合同 记录 删除 ! "，_ 
vblnformation, "删除 记录 " 
' 刷 新 查询 
Call 查询 合同 基本 信息 
Call 显示 合同 基本 信息 
Call 显示 合同 收费 情况 
End Sub 


11.8.10 ”查询 按钮 代码 设计 


【查询 】 按 钮 完成 查询 合同 基本 信息 的 任务 。 该 按钮 查询 的 依据 是 合同 号 。 用 户 需 要 查 
询 时 ， 单 击 该 按钮 。 程 序 首先 清除 了 窗 体 上 各 个 控件 的 数据 ， 然 后 弹出 一 输入 对 话 框 要 求 输 
入 查询 合同 的 合同 号 。 输 入 合同 号 后 ， 单 击 【 确 定 】 按 钮 。 程 序 逐 条 记录 在 合同 基本 信息 表 
中 查找 该 合同 号 ， 找 到 后 将 合同 基本 信息 和 收费 情况 显示 在 各 个 控件 上 。 以 下 是 该 按钮 的 单 
击 事件 代码 : 

Private Sub 查询 _Click() 
Dim myld As String 
Call 新 合同 _Click ' 清 除 窗 体 上 各 个 控件 的 数据 
myld = InputBox(" 请 输入 合同 号 :", "合同 查询 ") "获取 查询 合同 的 合同 号 
IfLen(Trim(myld)) = 0 Then 
MsgBox "没有 输入 合同 号 !", vbCritical, "警告 ” “提示 未 输入 合同 号 


Exit Sub 
End If 
rs.MoveFirst "将 合同 基本 信息 记录 集 定位 到 第 一 条 记录 


Fori= 1To rs.RecordCount 
Ifrs.Fields(" 合 同 号 ") = myld Then 找到 对 应 合同 号 后 ， 显 示 合同 基本 信息 和 收费 情况 
Call 显示 合同 基本 信息 
Call 显示 合同 收费 情况 


Exit Sub 
Else 

rs.MoveNext ' 移 动 到 下 一 条 记录 行 
End If 


Next 
MsgBox "没有 合同 号 为 <" & myld & "> 的 合同 !", vbCritical, "查询 结果 ”” “显示 提示 信息 
rs.MoveFirst 

End Sub 


11.8.11 浏览 记录 按钮 组 代码 设计 


在 窗 体 右 侧 排 布 的 按钮 中 ， 有 一 组 按钮 是 用 于 浏览 记录 的 。 这 些 按钮 包括 【第 一 条 】、 
【下 一 条 】、【 上 一 条 】 和 【最 末 条 】 4 个 按钮 。 这 些 按钮 共同 完成 浏览 记录 功能 ， 本 小 节 将 
这 些 按钮 的 代码 集中 起 来 一 起 介绍 。 以 下 是 这 些 按钮 的 详细 代码 : 


Private Sub 第 一 条 _Click() 
' 如 果 数 据 表 中 没有 记录 ， 就 退出 过 程 
If rs.BOF And rs.EOF Then Exit Sub 
' 如 果 已 经 是 第 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
If rs.BOF Then Exit Sub 
' 将 指针 移 到 第 一 条 记录 
rs.MoveFirst 
"如 果 已 经 是 第 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
If rs.BOF Then Exit Sub 
' 调 用 子 程序 在 窗 体 上 显示 第 一 条 记录 
Call 显示 合同 基本 信息 
Call 显示 合同 收费 情况 
End Sub 


Private Sub 下 一 条 _Click() 
"如 果 数 据 表 中 没有 记录 ， 就 退出 过 程 
If rs.BOF And rs.EOF Then Exit Sub 
"如 果 已 经 是 最 末 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
Ifrs.EOF Then Exit Sub 
' 将 指针 移 到 下 一 条 记录 
rs.MoveNext 
' 如 果 已 经 是 最 末 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
Ifrs.EOF Then Exit Sub 
' 调 用 子 程序 在 窗 体 上 显示 下 一 条 记录 
Call 显示 合同 基本 信息 
Call 显示 合同 收费 情况 
End Sub 


Private Sub 上 一 条 _Click() 
"如 果 数 据 表 中 没有 记录 ， 就 退出 过 程 
Ifrs.BOF And rs.EOF Then Exit Sub 
"如 果 已 经 是 第 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
Ifrs.BOF Then Exit Sub 
"将 指针 移 到 上 一 条 记录 
rs.MovePrevious 
' 如 果 已 经 是 第 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
If rs.BOF Then Exit Sub 
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' 调 用 子 程序 在 窗 体 上 显示 上 一 条 记录 
Call 显示 合同 基本 信息 
Call 显示 合同 收费 情况 

End Sub 


Private Sub 最 末 条 _Click() 
"如 果 数据 表 中 没有 记录 ， 就 退出 过 程 
If rs.BOF And rs.EOF Then Exit Sub 
"如 果 已 经 是 最 末 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
If rs.EOF Then Exit Sub 
' 将 指针 移 到 最 末 条 记录 
rs.MoveLast 
' 如 果 已 经 是 最 末 一 条 记录 ， 就 退出 过 程 ， 以 免 再 次 单 击 此 按钮 时 出 现 错误 
If rs.EOF Then Exit Sub 
' 调 用 子 程序 在 窗 体 上 显示 最 未 条 记录 
Call 显示 合同 基本 信息 
Call 显示 合同 收费 情况 
End Sub 


11.9 合同 收费 信息 管理 窗口 设计 


合同 收费 信息 管理 窗口 完成 对 合 同 收 和 费 情况 资料 的 添加 、 修 改 和 删除 等 操作 。 同 一 个 合 
同 允许 有 多 个 收费 信息 。 当 需要 查看 某 一 个 合同 所 有 的 收费 情况 信息 时 ， 可 以 在 合同 收费 信 
息 管理 窗口 的 合同 收费 信息 框架 中 查看 也 可 以 通过 该 窗口 选择 对 应 合同 号 查看 。 


11.9.1 窗口 界面 设计 


合同 收费 信息 管理 窗口 包含 的 控件 数量 较 合同 基本 信息 管理 窗口 少 ， 共 有 2 个 框架 控件 、 
5 个 标签 控件 、3 个 文本 框 控件 、2 个 复合 框 控件 、7 个 按钮 和 1 个 ListView 控件 。 该 窗口 的 
界面 如 图 11-34 所 示 。 
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图 11-34 合同 收费 信息 管理 窗口 界面 
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窗口 的 布局 和 合同 基本 信息 管理 窗口 一 致 ， 包 括 合同 收费 信息 输入 区 、 合 同 收费 情况 显 
示 区 以 及 按钮 区 。 表 11-6 列 出 了 本 窗 体 的 相关 控件 〈 不 包含 标签 控件 ) 。 
表 11-6 合同 收费 信息 管理 窗口 控件 列表 


控 件 名 | 控件 类 型 控件 说 明 
合同 收费 信息 | _ 框架 该 框架 用 于 分 隔 所 有 显示 或 设置 合同 收费 信息 的 控件 
合同 号 复合 框 包 含 了 所 有 已 建立 的 合同 的 合同 号 。 通 过 选择 合同 号 ， 窗 口 合同 


人 其 全 收费 情况 中 的 明细 项 目 会 随 之 更 新 ， 显示 相应 合同 的 收费 情况 

| 收费 类 别 复 合 框 包含 了 所 有 已 定义 的 合同 收费 类 别 。 通 过 单 击 该 控件 右 侧 的 
【添加 类 别 】 按 钮 ， 用 户 可 以 新 建新 收费 类 别 

本 该 按钮 用 于 添加 新 的 收费 类 别 。 添 加 完 收费 类 别 后 ， 收 费 类 别 复合 框 将 会 立即 


刷新 
收费 日 期 ” | 文本 框 ”| 该 文本 框 显示 或 设置 当前 合同 收费 信息 的 收费 日 其 

收费 金额 “| 文本 框 ”| 该 文本 框 显 示 或 设置 当前 合同 收费 信息 的 收费 金额 

备注 该 文本 框 显示 或 设置 当前 合同 收费 信息 的 备注 信息 

合同 收费 情况 该 框架 用 于 包含 显示 合同 收费 情况 的 ListView 控件 

ietVieiml 该 控件 用 于 显示 当前 合同 的 所 有 收费 情况 

新 记录 该 按钮 重 血 合 同 收 继 信 息 框架 中 的 控件 数据 ， 以 便 输入 新 合同 收 继 信 息 
添 放 该 按钮 用 于 为 当前 合同 添加 新 收费 信息 


修改 按 铀 。 | 该 按 包 用 于 修改 当前 显示 合同 收费 信息 
删除 | 按钮 ”| 该 按钮 用 于 删除 当前 显示 合同 收费 信息 

查询 按钮 。 ”| 该 按钮 用 于 查询 满足 当前 合同 号 的 所 有 合同 收费 情况 
退出 | “按钮 ”| 该 按钮 用 于 退出 当前 合同 收费 信息 管理 窗口 


建立 该 窗口 的 步骤 如 下 : 
(1) 在 VBE 环境 中 依次 选择 【插入 】|【 用 户 窗 体 】 命 令 建立 一 个 新 窗 体 ， 并 在 属性 窗 
口中 设置 该 窗 体 的 名 称 属 性 为 “合同 收费 信息 管理 ”， 如 图 11-35 所 示 。 

(2) 在 工具 箱 中 选择 框架 控件 。 在 窗 体 中 插入 一 个 框架 。 随 后 在 属性 窗口 中 设置 该 框架 
的 Caption 属性 为 “合同 收费 信息 ”， 名 称 属性 设置 为 Frame1， 如 图 11-36 所 示 。 


屋 性 - 合同 收费 信息 管理 四 


图 11-35 合同 收费 信息 管理 窗 体 属性 设置 图 11-36 合同 收费 信息 框架 属性 设置 


(3) 在 工具 箱 中 选择 标签 控件 。 在 窗 体 中 连续 插入 5 个 标签 控 件 。 随后 在 属性 窗口 中 设 
置 这 些 控件 的 Caption 属性 依次 为 “合同 号 ”、“ 收 费 类 别 ”、“ 收 费 日 期 ”、“ 收 费 金额 ” 
和 “备注 ”， 如 图 11-37 所 示 。 

(4) 在 工具 箱 中 选择 复合 框 控件 。 在 “合同 号 ”与 “收费 类 别 ” 标 签 右 侧 分 别 插入 一 个 
复合 框 ， 随 后 在 属性 窗口 中 设置 这 两 个 复合 框 的 名 称 为 “合同 号 ”和 “收费 类 别 ”。 
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SelectionMargin 属性 都 设置 为 False， 如 图 11-38 所 示 。 
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图 11-37 合同 收费 信息 管理 窗 体 设计 效果 图 11-38 ”设置 复合 框 控件 的 SelectionMargin 属性 


(5) 在 工具 箱 中 选择 按钮 控件 。 在 “收费 类 别 ” 复 合 框 右 侧 插入 一 个 按钮 。 随 后 在 属性 
窗口 中 设置 该 按钮 的 Caption 属性 为 “添加 类 别 ”， 名 称 属 性 为 “添加 类 别 ”， 如 图 11-39 

(6) 在 工具 箱 中 选择 文本 框 控件 。 在 “收费 日 期 ”、“ 收 费 金 额 ” 和 “备注 ”标签 右 侧 
分 别 插入 文本 框 。 随 后 在 属性 窗口 中 设置 这 些 文本 框 的 名 称 属性 依次 为 “收费 日 期 ”、“ 收 
费 金 额 ”、“ 备 注 ”，SelectionMargin 属性 都 设置 为 False。 

(7) 在 工具 箱 中 选择 框架 控件 。 在 窗 体 上 插入 一 个 框架 。 随 后 在 属性 窗口 中 设置 该 框架 
的 Caption 属性 为 “合同 收费 情况 ”， 名 称 属性 设置 为 Frame2， 如 图 11-40 所 示 。 


| 屋 性 -添加 类 别 可 
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图 11-39 ”添加 类 别 按钮 属性 设置 图 11-40 合同 收费 情况 框架 属性 设置 


(8) 在 工具 箱 中 选择 ListView 控件 。 在 “合同 收费 情况 ”框架 中 插入 一 个 ListView 控件 ， 
随后 在 属性 窗口 中 设置 该 控件 的 名 称 属性 为 ListView1。 

(9) 在 工具 箱 中 选择 按钮 控件 。 在 “合同 收费 信息 ”框架 右 侧 连 续 插入 6 个 按钮 ， 随 后 
在 属性 窗口 中 设置 这 些 按钮 的 Caption 属性 依次 为 “新 记录 ”、“ 添 加 ”、“ 修 改 ”、“ 删 除 ”、 
“查询 ”和 “退出 ”。 设 置 这 些 控 件 的 名 称 属性 与 其 Caption 属性 一 致 。 


11.9.2 窗口 初始 化 与 关闭 事件 代码 设计 


本 小 节 讲 述 的 是 该 窗 体 的 初始 化 与 关闭 事件 代码 。 窗 口 初始 化 过 程 完成 的 工作 主要 是 设 
置 窗 体 控件 状态 、 链接 数据 库 、 设置 复合 框 、 显 示 合同 收费 信息 和 显示 合同 收费 情况 。 图 11-41 


PP 


显示 的 是 该 窗 体 初始 化 过 程 的 流程 图 。 


设置 控件 状态 


设置 收费 类 别 复合 框 项 目 


设置 合同 号 复合 框 项 目 


显示 合同 收费 情况 


图 11-41 合同 收费 信息 管理 窗口 初始 化 代码 流程 图 


该 窗口 的 初始 化 代码 如 下 : 


Private Sub UserForm_lnitialize() 


Dim mydata As String 
Dim SQL As String 
Dim i As Integer 
' 指 定数 据 库 
mydata = ThisWorkbook.Path & "合同 管理 .mdb" 
' 设 置 窗 体 控件 组 (也 是 数据 表 的 各 个 字段 组 ) 
myArray = Array(" 合 同 号 ", "收费 类 别 ", "收费 日 期 "收费 金额 ", "备注 ") 
' 设 置 窗 体 控件 的 背景 颜色 
Fori= 0 To UBound(myArray) 
Me.Controls(myArray(i)).BackColor = &HEOEOEO "指定 控件 背景 色 
Next 
' 建 立 与 数据 库 的 连接 
Set cnn = New ADODB.Connection 
With cnn 
.Provider = "microsoftjet.oledb.4.0" "指定 链接 的 Provider 属性 
.Open mydata "开启 链接 
End With 
"调用 子 程序 ， 为 收费 类 别 复 合 框 设 置 项 目 
Call 收费 类 别 复 合 框 设 置 
"从 “合同 基本 信息 ”中 查询 合同 号 ， 设 置 给 “合同 号 ”复合 杠 
Dim rsx As New ADODB.Recordset 
SQL = "select 合同 号 from 合同 基本 信息 " 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 和 打开 记录 集 


With 合同 号 
.Clear "清除 合同 号 复合 框 记 录 
Fori= 1To rsx.RecordCount 
.Addltem rsx.Fields(" 合 同 号 ") ' 添 加 合同 号 记录 
rsx.MoveNext ' 将 记录 向 下 移动 一 条 
Next 
End With 
合同 号 .ListIndex = 0 ' 指 定 合同 号 复合 框 默 认 值 
rsx.Close ' 关 闭 记录 集 


Set rsx = Nothing 
"调用 子 程序 ， 查 询 并 显示 合同 收费 明细 信息 
Call 查询 合同 收费 明细 "调用 查询 合同 收费 明细 过 程 


办 公 应 用 沸 党 乞 比 
Excel VBA 应 用 开发 经 典 案例 


Call 显示 合同 收费 明细 
End Sub 


Private Sub 退出 _Click() 
cnn.Close 
Set rs = Nothing 
Set cnn = Nothing 
Unload 合同 收费 信息 管理 
End Sub 


11.9.3 复合 框 设置 代码 设计 


在 合同 收费 信息 框架 中 ， 包 含 了 合同 号 复合 框 和 收费 类 别 复 


"调用 显示 合同 收费 明细 过 程 


' 关 闭 数据 库 链接 
"清除 记录 集 内 存 空间 
"清除 链接 内 存 空 间 
"卸载 窗口 


合 框 两 个 复合 框 ， 其 中 设置 


合同 号 复合 框 的 过 程 已 经 在 窗口 初始 化 代码 中 完成 。 因而 在 这 里 讲述 的 只 是 合同 号 复合 框 改 


变 事件 和 收费 类 别 复合 框 设置 项 目 。 


当 合 同 号 复合 框 的 输入 内 容 改 变 时 ， 程 序 首先 将 各 个 控件 的 显示 数据 清除 ， 然 后 查询 当 


前 输入 合同 的 收费 明细 并 显示 出 来 ， 最 后 把 合同 号 、 


在 公共 变量 中 。 


收费 类 别 、 收 费 日 期 以 及 收费 金额 保存 


设置 收费 类 别 复 合 框 的 过 程 是 : 首先 从 收费 类 别 信息 表 中 获取 记录 集 ， 然 后 将 该 记录 集 
中 的 收费 类 别 字 段 中 保存 的 数据 ?4 瑟 入 到 收 费 类 别 复合 框 的 项 目 中 。 


Private Sub 合同 号 _Change() 
Dim i As Integer 
Fori= 1 To UBound(myArray) 
Me.Controls(myArray(i)).Value = ™ 
Next 
Call 查询 合同 收费 明细 
Call 显示 合同 收费 信息 
Call 显示 合同 收费 明细 
hth = 合同 号 .Value 
sflb = 收费 类 别 .Value 
sfrq = Format( 收 费 日 期 .Value, "yyyy-mm-dd") 
sfje = Val( 收 费 金额 .Value) 
End Sub 


Public Sub 收费 类 别 复合 框 设 置 () 
Dim rsx As New ADODB.Recordset 


"清除 控件 数据 


"调用 查询 合同 收费 明细 过 程 
"调用 显示 合同 收费 信息 过 程 
"调用 显示 合同 收费 明细 过 程 
"保存 合同 号 

"保存 收费 类 别 

"保存 收费 日 期 

"保存 收费 金额 


rsx.Open "收费 类 别 信息 " cnn, adOpenKeyset, adLockOptimistic 获取 收费 类 别 记 录 集 


With 收费 类 别 
.Clear 
Fori= 1 To rsx.RecordCount 
.Addltem rsx.Fields(0) 
rsx.MoveNext 
Next 
End With 
rsx.Close 
Set rsx = Nothing 
End Sub 


' 清 空 收费 类 被 复合 框 项 目 
' 添 加 收费 类 被 项 目 
' 将 记录 集 指针 移 到 下 一 条 


"清除 记录 集 占 用 内 存 空间 
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11.9.4 查询 、 显 示 合 同 收费 信息 代码 设计 


前 面 的 窗口 初始 化 代码 与 合同 号 复合 框 改变 事件 中 都 涉及 到 了 查询 、 显 示 合 同 收费 信息 
的 自 定义 过 程 。 这 些 自 定义 过 程 完成 获取 合同 收费 信息 记录 集 与 显示 合同 收费 信息 的 工作 。 
各 个 过 程 的 功能 描述 如 下 : 
口 查询 合同 收费 明细 过 程 : 根据 用 户 输入 的 合同 号 ， 在 数据 库 中 查询 对 应 合同 号 的 所 
有 收费 情况 。 其 查询 结果 被 保存 在 一 公共 记录 集 对 象 中 ， 该 记录 集 对 象 将 在 显示 合 
同 收费 明细 过 程 中 被 调用 。 
口 显示 合同 收费 信息 过 程 :该 过 程 用 于 将 查询 合同 收费 信息 记录 和 集 的 第 一 条 记录 显示 
E 合 同 收费 信息 框架 的 几 个 控件 中 。 
口 显示 合同 收费 明细 过 程 :该 过 程 显示 查询 合同 收费 信息 记录 集 的 所 有 记录 到 ListView 
控件 中 。 
以 下 是 这 3 个 过 程 的 代码 解释 : 
Public Sub 查询 合同 收费 明细 () 
Dim SQL As String 
SQL = "select * from 合同 收费 信息 where 合同 号 =" & 合同 号 .Value & "" "设置 查询 字符 串 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 和 打开 记录 集 
End Sub 


Public Sub 显示 合同 收费 信息 () 
On Error Resume Next 
Dim i As Integer 
"显示 合同 收费 的 第 一 条 信息 
Fori=0ToUBound(myArray) 
If lsNull(rs.Fields(i)) Then 


Me.Controls(myArray(i)).Value = ™" ' 当 记录 集 为 空 时 ， 清 空 控 件数 据 
Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) “记录 集 不 为 空 时 ， 显 示 对 应 字段 到 控件 中 
End If 
Nexti 
End Sub 


Public Sub 显示 合同 收费 明细 () 
On ErrorResume Next 
With ListView1 
"设置 ListView1 的 标题 、 显 示 类 型 、 整 行 选择 和 网 格 线 属性 


.ColumnHeaders.Clear "清除 ListView 控件 标题 
.Listltems.Clear "清除 ListView 控件 数据 项 
.View = lvwReport ' 设 置 ListView 控件 显示 模式 
.FullRowSelect = True "允许 整 行 选 择 

.Gridlines = True "显示 网 格 线 

为 ListView1 设置 标题 


Fori= 0 To rs.Fields.Count -1 


办公 应 用 非 常 之 纶 


Excel VBA 应 用 开发 经 典 案例 


.ColumnHeaders.Add , , rs.Fields(i).Name "添加 控件 标题 
Next i 
为 ListView1 设置 各 行 数 据 
Fori= 1Tors.RecordCount 
.Listltems.Add , , rs.Fields(0).Value 为 ListView 控件 添加 项 目 


Forj = 1 To rs.Fields.Count -1 
.Listltems(i).Subltems(j) = rs.Fields(j).Value 指定 新 项 目的 子 项 数据 


Nextj 
rs.MoveNext 将 记录 集 指向 下 一 条 
Next 
End With 
rs.MoveFirst 将 记录 集 指针 指向 第 一 条 记录 


End Sub 
11.9.5 ”添加 类 别 按钮 代码 设计 


【添加 类 别 】 按 钮 用 于 新 增 类 别 。 在 类 别 复合 框 中 输入 类 别 后 ， 单 击 该 按钮 ， 新 类 别 将 
会 被 保存 到 收费 类 别 信息 表 中 。 在 执行 该 过 程 中 ， 程 序 首先 检测 用 户 是 否 已 输入 收费 类 别 ， 
确认 以 后 程序 打开 到 费 类 别 信息 表 的 记录 集 。 当 记录 集中 没有 该 收费 类 别 时， 程序 将 该 新 收 
费 类 别 添 加 进 收费 类 别 信息 表 中 。 如 图 11-42 所 示 的 是 该 过 程 的 流程 图 。 


是 
获取 收费 类 别 记录 集 
一 收费 类 别 是 否 已 存在 ? 


添加 新 收费 类 别 
重 置 收费 类 别 复合 框 


图 11-42 添加 合同 收费 类 别 流程 图 


以 下 是 该 按钮 的 单 击 事件 代码 解释 : 
Private Sub 添加 类 别 _Click() 
Dim lb As String 
lb = 收费 类 别 .Value 
fLen(Trim(lb)) = 0 Then 
MsgBox "没有 输入 收费 类 别名 称 ! 不 能 添加 ! ", vbCritical, "警告 " "提示 未 输入 收费 类 别 
Exit Sub 
End If 
Dim rsx As New ADODB.Recordset 
Dim SQL As String 
SQL = "select * from 收费 类 别 信息 where 收费 类 别 =" & lb & "" "生成 查询 字符 串 
rsx.Open SQL, cnn, adOpenKeyset, adLockOptimistic 获取 指定 收费 类 被 的 收费 类 别 记 录 集 


是 


_ 
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If rsx.BOF And rsx.EOF Then 
' 当 记录 集 为 空 时 ， 将 新 输入 的 收费 类 别 保存 到 收费 类 别 表 中 
rsx.AddNew "添加 新 记录 
rsx.Fields(0) = lb "保存 新 收费 类 别 
rsx.Update "更 新 记录 集 
MsgBox "添加 完毕 ! ", vblnformation, "添加 收费 类 别 " "提示 保存 成 功 
Else 
MsgBox "已 经 存在 了 同名 的 收费 类 别名 称 !", vbCritical, "警告 ” ”' 提 示 收 费 类 别 已 经 存在 
End 上 f 
rsx.Close "关闭 记录 集 
Set rsx = Nothing "清空 记录 集 占 用 内 存 
Call 收费 类 别 复 合 框 设 置 ' 重 置 收 费 类 别 复 合 框 
收费 类 别 .Value = Ib "设置 收费 类 别 复 合 框 的 显示 值 
End Sub 


11.9.6 ”新 记录 与 添加 按钮 代码 设计 


当 用 户 需 要 通过 合同 收费 信息 管理 窗口 添加 新 的 合同 收费 信息 时 ， 需 要 完成 两 步 操作 。 
首先 用 户 需 要 单 击 【新 记录 】 按 钮 来 清除 合同 收费 信息 与 合同 收费 情况 框架 中 部 分 控件 的 内 
容 ， 然 后 用 户 可 以 在 这 些 被 清空 空 件 中 输入 新 的 合同 收费 信息 ， 最 后 单 击 【 添 加 】 按 
钮 让 程序 自动 完成 新 合同 信息 添加 工作 。 该 小 节 将 两 个 按钮 的 代码 放置 在 一 起 ， 正 是 因为 这 
两 个 按钮 完成 的 工作 是 同一 个 任务 的 两 个 步骤 。 

其 中 ，【 添 加 】 按 钮 的 单 击 事件 的 代码 比较 复杂 。 单 击 【 添 加 】 按 钮 时 ， 程 序 首 先 检 查 
用 户 是 否 在 窗口 输入 了 必要 的 合同 收费 信息 。 满 足 条 件 后 程序 从 数据 库 中 获取 合同 总 金额 与 
合同 收费 合计 信息 。 然 后 程序 比较 这 两 个 数据 ， 判 断 是 否 需 要 登记 新 的 合同 收费 信息 。 最 后 
程序 将 刷新 窗口 的 显示 数据 ， 以 显示 用 户 添加 的 合同 收费 数据 。 如 图 11-43 所 示 是 【添加 】 按 


钮 单 击 事件 的 流程 图 。 
是 
RR 
添加 新 合 ji 


ee 7 一 


图 11-43 【添加 】 按钮 单 击 事件 流程 图 


办 公 应 用 莫 常 之 禾 
Excel VBA 应 用 开发 经 典 案例 2 时 Sc 和 


以 下 是 这 两 个 按钮 的 单 击 事件 代码 解释 : 
Private Sub 新 记录 _Click() 


On Error Resume Next 


Dim i As Integer 
Fori= 0 To UBound(myArray) 
Me.Controls(myArray(i)) Value =" "清空 控件 显示 数据 
Next 
收费 类 别 .ListIndex = 0 ' 设 置 收费 类 别 复合 框 默 认 显 示 值 
收费 日 期 .Value = Format(Date, "yyyy-mm-dd") "设置 收费 日 期 
合同 号 .SetFocus "设置 鼠标 焦点 
End Sub 


Private Sub 添加 _Click() 


Dim i As Integer 
Dim TotalMoney As Currency, Totallncome As Currency 
Dim rsCurrency As ADODB.Recordset 
判断 是 否 在 窗 体 上 输入 了 必要 的 合同 收费 数据 
Fori= 0 To UBound(myArray) 
If Me.Controls(myArray(i)).Name <> "备注 " Then 备注 项 不 需 检查 
If Me.Controls(myArray(i)).Value = " Then 
MsgBox Me.Controls(myArray(i)).Name & "不 能 为 空 ! " vbCritical 


提示 有 未 输入 数据 时 
Me.Controls(myArray(i)).SetFocus "定位 未 输入 数据 控件 
Exit Sub "退出 过 程 
End If 
End If 


Next 
If MsgBox(" 本 操作 将 添加 新 的 合同 收费 记录 !" & vbCrLf & "是 否 要 添加 ? "，_ 
vbQuestion + vbYesNo, "添加 记录 ") = vbNo Then Exit Sub ”提示 是 否 添加 新 合同 收费 信息 
' 首 先 判断 在 数据 库 中 该 合同 的 收费 与 欠 费 是 否 已 经 平衡 
' 查 询 该 合同 的 总 金额 
Set rsCurrency = New ADODB.Recordset 
SQL = "select 合同 金额 from 合同 基本 信息 where 合同 号 =" & 合同 号 .Value & "" 


生成 查询 字符 串 
rsCurrency.Open SQL, cnn, adOpenKeyset, adLockOptimistic "获取 合同 金额 记录 集 
TotalMoney = rsCurrency.Fields(" 合 同 金 额 ") "保存 合同 金额 


"查询 该 合同 的 收费 合计 
Set rsCurrency = New ADODB.Recordset 
SQL = "select sum( 收 费 金额 ) as aa from 合同 收费 信息 "”_ 

& "where 合同 号 =" & 合同 号 .Value & "" 生成 查询 字符 串 
rsCurrency.Open SQL, cnn, adOpenKeyset, adLockOptimistic ”获取 合同 收费 金额 记录 集 
If IsNull(rsCurrency.Fields!aa) Then 


TotallIncome = 0 ' 当 没有 收费 金额 时 ， 保 存 合同 收费 金额 为 0 
Else 
TotallIncome = rsCurrency.Fieldslaa ' 有 收费 金额 时 ， 直 接 保存 该 合同 收费 金额 
End If 
"判断 合同 费用 是 否 已 经 结 清 
IfTotallncome >= TotalMoney Then ' 当 合同 收费 金额 未 超过 合同 总 金额 时 ， 可 以 添加 
新 合同 收费 金额 


MsgBox "该 合同 的 各 项 费用 已 经 结 清 ! 不 能 再 添加 记录 !", vbCritical, "警告 " 


Ah 
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Else 

"准备 将 窗 体 上 的 数据 添加 到 数据 库 中 
SQL = "select * from 合同 收费 信息 " 生成 查询 字符 串 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset adLockOptimistic 获取 合同 收费 信息 记录 集 
' 开 始 添加 数据 
With rs 

.AddNew "添加 新 数据 

Fori=0ToUBound(myArray) 

上 Me.Controls(myArray(i)).Name = "收费 日 期 "Then 
.Fields(i) = Format(Me.Controls(myArray(i)).Value, "yyyy-mm-dd") 


' 设 置 收费 日 期 字段 数据 
Else 
.Fields(i) = Me.Controls(myArray(i)).Value ”' 设 置 其 他 字段 数据 
End 上 
Next 
.Update 更 新 数据 表 
End With 
MsgBox "已 经 成 功 将 该 合同 的 收费 数据 添加 到 数据 库 中 !", vblnformation, "添加 记录 " 
' 刷 新 显示 
Call 显示 合同 收费 信息 ' 调 用 显示 合同 收费 信息 过 程 
Call 查询 合同 收费 明细 ' 调 用 查询 合同 收费 明细 过 程 
Call 显示 合同 收费 明细 ' 调 用 显示 合同 收费 明细 过 程 
End If 
rsCurrency.Close "关闭 记录 集 
Set rsCurrency = Nothing "清空 记录 集 占 用 内 存 
End Sub 


11.9.7 ”修改 按钮 代码 设计 


用 户 在 窗口 中 单 击 【修改 】 按 钮 后 ， 程 序 首先 提示 用 户 是 否 进行 修改 操作 ， 当 被 用 户 
确认 后 ， 程 序 生成 更 新 数据 库 查 询 字符 串 ， 然 后 通过 记录 集 对 象 执行 该 更 新 记录 集 查 询 字符 
串 ， 最 后 程序 将 该 窗口 刷新 以 体现 用 户 做 出 的 修改 。 如 图 11-44 所 示 的 是 该 按钮 的 单 击 事 


件 流程 。 
一 和 一 


图 11-44 修改 合同 收费 信息 流程 图 


以 下 是 该 按钮 单 击 事件 过 程 代 码 解释 : 


Private Sub 修改 _Click() 
If MsgBox(" 本 操作 将 修改 合同 号 为 <" & hth & "> 的 合同 收费 记录 !" _ 


& vbCrLf & "是 否 要 更 新 ? "，_ 

vbQuestion + vbYesNo, "更 新 记录 ") = vbNo Then Exit Sub "提示 是 否 修改 合同 收费 信息 
Dim i As Integer 
' 修 改 更 新 记录 


SQL = "update 合同 收费 信息 set"_ 
& "合同 号 =" & hth &""_ 
& "收费 类 别 =" & 收费 类 别 .Value & ",”_ 
& "收费 日 期 =#" & Format( 收 费 日 期 .Value, "yyyy-mm-dd") & "#,”_ 
& "收费 金额 =" & Val( 收 费 金额 ) & ""”_ 
& "备注 =" & Trim( 备 注 .Value)&""_ 
&" where 合同 号 =" & hth&"™_ 
& "and 收费 类 别 =" & sflb & "_ 
&" and 收费 日 期 =#" & sfrq & "#" _ 


&" and 收费 金额 =" & sfje 生成 更 新 查询 字符 串 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 执行 更 新 查询 
MsgBox "已 经 成 功 将 编号 为 <" & hth & "> 的 合同 收费 记录 进行 了 更 新 ! "_ 
vblnformation, "更 新 记录 " ' 显 示 更 新 成 功 提示 
' 刷 新 显示 
Call 查询 合同 收费 明细 ' 调 用 查询 合同 收费 明细 过 程 
Call 显示 合同 收费 明细 ' 调 用 显示 合同 收费 明细 过 程 
End Sub 


11.9.8 删除 按钮 代码 设计 
【删除 】 按 钮 执行 的 操作 与 【和 更新】 按钮 类 似 ， 唯 一 不 同 之 处 在 于 该 查询 字符 串 是 一 个 

删除 查询 字符 串 而 已 。 该 按钮 单 击 事件 的 流程 图 如 图 11-45 所 示 。 

A 

| 生成 删除 查询 字符 品 ] 

| 执行 删除 查询 | 


图 11-45 【删除 】 按 钮 单 击 事件 流程 图 
以 下 是 该 单 击 事件 的 代码 解释 : 


Private Sub 删除 _Click() 
上 MsgBox(" 本 操作 将 删除 编号 为 <" & hth & "> 的 合同 收费 记录 !" _ 


Ah 
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& vbCrLf & "是 否 要 删除 ?"，_ ' 提 示 是 否 删 除 合同 收费 记录 
vbQuestion + vbYesNo, "删除 记录 ") = vbNo Then Exit Sub 
SQL = "delete from 合同 收费 信息 where 合同 号 =" & hth& "" 
& "and 收费 类 别 =" & sflb &"_ 
& "and 收费 日 期 =#" & sfrq & "#" _ 


&" and 收费 金额 =" & sfje 生成 删除 查询 字符 串 
Set rs = cnn.Execute(SQL) “运行 删除 查询 
MsgBox "已 经 成 功 将 编号 为 <" & hth & "> 的 合同 收费 记录 删除 ! "，_ 
vblnformation, "删除 记录 " 提示 删除 成 功 信息 
' 刷 新 显示 
Call 查询 合同 收费 明细 ' 调 用 查询 合同 收费 明细 过 程 
Call 显示 合同 收费 明细 ' 调 用 显示 合同 收费 明细 过 程 


End Sub 
11.9.9 查询 按钮 代码 设计 


本 窗口 中 的 查询 功能 只 能 完成 对 对 应 合同 号 的 查询 工作 。 当 用 户 单 击 【 查 询 】 按 钮 时 ， 
旦 序 首先 将 清空 所 有 控件 的 显示 数据 ， 然 后 弹出 一 个 输入 对 话 框 要 求 用 户 输入 查询 合同 号 。 
用 户 完成 输入 后 ， 程 序 在 合同 收费 信息 表 中 查询 满足 指定 合同 号 的 记录 集 。 当 该 记录 集 有 记 
录 时 , 程序 将 该 记录 信息 显示 到 窗口 中 作为 用 户 的 查询 结果 。 图 11-46 是 该 按钮 单 击 事件 的 流 
程 图 。 


重 置 控件 显示 数据 


查询 合同 收费 信息 
显示 合同 收费 信息 
显示 合同 收费 明细 


图 11-46 【查询 】 按 钮 单 击 事件 流程 图 


以 下 是 该 按钮 单 击 事件 的 代码 解释 : 
Private Sub 查询 _Click() 
Dim myld As String 
Dim SQL As String 
Dim i As Integer 
Dim rsSerch As New ADODB.Recordset 
Fori= 0 To UBound(myArray) 


Me.Controls(myArray(i)).Value = ™ ' 置 空 控 件数 据 
Next 
ListView1.Listttems.Clear "清空 ListView 控件 显示 项 目 
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myld = InputBox(" 请 输入 合同 号 : ", "合同 查询 ") 获取 查询 合同 号 

If Len(Trim(myld)) = 0 Then 愉 查 用 户 是 否 输入 合同 号 
MsgBox "没有 输入 合同 号 !", vbCritical, "警告 " 提示 用 户 未 输入 合同 号 
Exit Sub 

End If 


SQL = "select * from 合同 收费 信息 where 合同 号 =" & myld & "" ”生成 查询 字符 串 
Set rs = New ADODB.Recordset 


rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 获取 自 定 合同 号 的 合同 收费 
信息 记录 集 
If rs.BOF And rs.EOF Then 检测 记录 集 是 否 有 记录 
MsgBox "没有 合同 号 为 <" & myld & "> 的 合同 收费 信息 !", vbCritical, "查询 结果 " 
提示 无 此 合同 号 
Else 
Call 显示 合同 收费 信息 ' 调 用 显示 合同 收费 信息 过 程 
Call 显示 合同 收费 明细 ' 调 用 显示 合同 收费 明细 过 程 
End 上 f 
End Sub 


11.9.10 “ListView 控件 项 目 单 击 事件 代码 设计 


在 合同 收费 情况 框架 中 的 ListView 控件 中 选择 项 目 时 ,需要 将 该 项 目的 数据 显示 在 合同 
收费 信息 框架 中 。 程 序 通 过 调用 查询 合同 收费 明细 过 程 得 到 该 合同 号 的 合同 收费 信息 记录 
集 。 为 了 定位 到 用 户 选择 项 目 对 应 的 记录 ， 程 序 首先 将 记录 指针 定位 到 首 条 记录 ， 然 后 通过 
记录 集 的 AbsolutePosition 属性 定位 到 选 定 项 目的 索引 号 记录 ， 最 后 程序 将 该 记录 的 数据 显 
示 到 合同 收费 信息 框架 的 对 应 控件 中 , 其 中 有 部 分 数据 需要 保存 到 公共 变量 中 以 供 其 他 功能 
调用 。 

Private Sub ListView1_ltemcClick(ByVal ltem As MSComctlLib.Listltem) 


Dim i As Integer 

Call 查询 合同 收费 明细 ”' 调 用 查询 合同 收费 明细 过 程 ， 获 取 对 应 合同 的 合同 收费 信息 记录 集 
rs.MoveFirst ' 将 记录 指针 定位 到 首 条 记录 

rs.AbsolutePosition = ltem.Index "将 记录 指针 定位 到 用 户 选 定 项 目 对 应 记录 行 


Fori=0ToUBound(myArray) 
If IsNull(rs.Fields(i)) Then 
Me.Controls(myArray(i)).Value = "” “' 当 记录 字段 为 空 时， 将 对 应 控件 数据 显示 为 空 


Else 
Me.Controls(myArray(i)).Value = rs.Fields(i) "显示 字段 的 数据 到 对 应 控件 中 
End If 
Next 
hth = 合同 号 .Value "保存 合同 号 
sflb = 收费 类 别 .Value "保存 收费 类 别 
sfrq = Format( 收 费 日 期 .Value, "yyyy-mm-dd") "保存 收费 日 期 
sfje = Val( 收 费 金额 .Value) "保存 收费 金额 
End Sub 
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11.10 合同 信息 查询 与 导出 窗口 设计 


在 合同 信息 查询 与 导出 窗口 中 ， 用 户 可 以 完成 对 已 建立 信息 合同 的 查询 与 导出 工作 。 该 
窗口 的 查询 条 件 设 置 比 合同 基本 信息 管理 窗口 和 合同 收费 信息 管理 窗口 全 面 。 


11.10.1 窗口 界面 设计 


合同 信息 查询 与 导出 窗口 中 包含 的 数量 众多 ， 包 含 了 3 个 框架 控件 、6 个 标签 控件 、5 个 
复合 框 控 件 、4 个 按钮 控件 和 1 个 ListView 控件 。 该 窗口 的 界面 如 图 11-47 所 示 。 


EDIEEEEET 划 


三 选 要 坦 询 的 信 息 可 关机 庆 去 涯 寺 一 各 
生计 件 

这 主要 查询 的 信 息 种 党 至 芋 寺 局 5 | 
识 要 油条 作 i) 


吉海 项 目 bay 条 促 人 2 | 
Fe | Fe = rw ewm | 


图 11-47 合同 信息 查询 与 导出 窗口 界面 


值得 注意 的 是 ， 在 设置 查询 条 件 框架 包含 的 4 个 复合 框 中 ， 其 中 一 个 在 程序 运行 当中 可 
能 会 被 隐藏 。 当 用 户 设置 查询 运算 符 为 between 时 ， 最 后 一 个 复合 框 才 会 被 显示 出 来 。 合 同 信 
息 查询 与 导出 窗口 控件 列表 见 表 11-7。 


表 11-7 合同 信息 查询 与 导出 窗口 控件 列表 


控件 名 称 | 控件 类 型 控件 说 明 
该 框架 将 选择 查询 信息 种 类 和 设置 查询 条 件 功能 区 域 与 其 他 部 分 划分 开 来 。 它 
Framel 框架 内 部 还 包含 了 另外 一 个 框架 ， 用 于 设置 查询 条 件 。 框 架 Caption 属性 为 “选择 要 
查询 信息 种 类 和 设置 查询 条 件 ” 
该 复合 框 选择 项 目 用 于 区 分 筛选 条 件 的 查询 信息 种 类 。 有 合同 基本 信息 与 合同 
收费 信息 两 种 
Frame3 框架 该 框架 内 部 包含 的 控件 用 于 设置 查询 条 件 。 框 架 Caption 属性 为 “设置 查询 条 件 ” 
查询 项 目 复合 框 该 复试 要 移 择 项 目 用 于 设置 所 需 查询 的 项 目 名 称 ， 包 括 合同 号 、 项 目 名 称 、 委 
托 单位 竺 
运算 符 复合 框 | 该 复合 框 选 择 项 目 用 于 设置 查询 条 件 的 运算 方式 ， 包 括 =、>、< 等 
条 件 值 1 复合 框 | 该 复合 框 用 于 设置 查询 项 目 满足 的 条 件 ， 该 复合 框 始 终 可 见 
该 复合 框 用 于 设置 查询 项 目 满足 的 条 件 。 只 有 运算 符 为 between 时 , 该 复合 框 才 
可 见 


信息 种 类 复合 框 


条 件 值 2 复合 框 


433 


办 公 应 用 意 党 之 稍 


Excel VBA 应 用 开发 经 典 案例 


续 表 

控件 名 称 | 控件 类 型 控件 说 明 

Frame2 框架 该 框架 包含 显示 查询 结果 的 ListView 控件 

Listveiwl ListView | 该 控件 用 于 显示 查询 结果 

重 设 条 件 按钮 清空 窗口 输入 控件 ， 以 便 输 入 新 的 查询 条 件 

开始 查询 按钮 pe 前 查询 条 件 查 询 数据 库 ， 并 将 查询 结果 显示 在 ListView 控 

数据 导出 按钮 单 击 该 按钮 将 把 已 查询 并 显示 在 ListView 控件 中 的 记录 导出 到 一 新 工作 禾 中 

关闭 窗 体 按钮 用 于 关闭 窗口 


建立 该 窗口 的 步骤 如 下 
(1) 在 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 在 属性 窗口 中 设置 新 插 
入 窗 体 的 名 称 属性 为 “合同 信息 查询 与 导出 ”， 如 图 11-48 所 示 。 


屋 性 - 合同 信息 查 交 与 导出 E| 


图 11-48 合同 信息 查询 与 导出 窗 体 属性 设置 


(2) 在 工具 箱 中 选择 框架 控件 。 在 窗口 中 连续 插入 3 个 框架 ， 将 第 二 个 框架 置 于 第 一 个 
框架 的 中 下 部 。 随 后 在 属性 窗口 中 设置 3 个 框架 的 Caption 属性 依次 为 “选择 要 查询 的 信息 种 
类 和 设置 查询 条 件 ”、 


(3) 在 了 


“设置 查询 条 件 ” 和 “查询 结果 显示 ”， 如 图 11-49 所 示 。 


信息 查询 与 导出 (UserForm) 


择 要 查询 的 信息 种 类 ”、 


图 11-49 合同 信息 查询 与 导出 窗 体 设计 效果 


[ 具 箱 中 选择 标签 控件 。 在 第 一 个 框架 中 的 上 部 插入 一 个 标签 ， 然 后 在 第 二 个 框 
架 中 的 上 部 依次 插入 5 个 标签 。 随 后 在 属性 窗口 中 设置 这 6 个 标签 的 Caption 属性 依次 为 “ 选 


“查询 项 目 » 、 “运算 符 ” 、 “条 件 值 1”、 “条 件 值 2” 和 “and” 。 
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(4) 在 工具 箱 中 选择 复合 框 控件 。 在 第 一 个 框架 中 刚 插 入 标签 的 右边 插入 一 个 复合 
然后 在 第 二 个 框架 中 的 下 部 依次 插入 4 个 复合 框 。 随 后 在 属性 窗口 中 设置 这 5 个 复合 框 的 名 
称 属性 依次 为 : “信息 种 类 ”、“ 查 询 项 目 ”、“ 运 算 符 ”、“ 条 件 值 1” 和 “条 件 值 2”。 
将 SelectionMargin 属性 都 设置 为 False。 

(5) 在 工具 箱 中 选择 ListView 控件 。 在 窗口 的 第 三 个 3 

框架 中 插入 一 个 ListView 控件 ,随后 在 属性 窗口 中 设置 该 控 
件 的 名 称 属性 为 ListView1， 如 图 11-50 所 示 。 
(6) 在 工具 箱 中 选择 按钮 控件 。 在 窗口 的 右 侧 连续 插 
入 4 个 按钮 控件 。 随 后 在 属性 窗口 中 设置 这 些 按钮 的 名 称 属 
性 依次 为 “ 重 设 条 件 ”、“ 开 始 查询 ”、“ 数 据 导出 ”和 “关闭 窗 体 ”。 然 后 设置 这 些 按钮 
的 Caption 属性 和 名 称 一 致 即 可 。 


11.10.2 ”窗口 初始 化 与 关闭 事件 代码 


图 11-50 ”ListView 控件 属性 设置 


合同 信息 查询 与 导出 窗口 初始 化 时 ， 需 要 完成 3 个 任务 ， 分 别 是 链接 数据 库 、 设 置信 息 
种 类 复合 框 项 目 、 设 置 运算 符 复合 框 项 目 。 该 过 程 的 流程 十 分 简单 ， 只 是 由 于 过 程 中 0 
加 的 项 目 较 多 造成 过 程 代码 较 长 ， 这 里 不 再 列 出 该 过 程 的 流程 图 。 在 窗口 关闭 时 ， 程 序 
要 清理 一 些 变 量 然后 关闭 窗口 。 

以 下 是 这 两 个 过 程 的 代码 解释 : 


Private Sub UserForm_lnitialize() 
Dim mydata As String 


"指定 数据 库 

mydata = ThisWorkbook.Path & "合同 管理 .mdb" ' 指 定数 据 库 所 在 位 置 

"建立 与 数据 库 的 连接 

Set cnn = New ADODB.Connection 

With cnn 
.Provider = "microsoftjet.oledb.4.0" "指定 数据 库 链 接 的 Provider 属性 
.Open mydata "开启 数据 库 链接 

End With 

"为 信息 种 类 复合 框 设 置 项 目 

With 信息 种 类 
.Addltem "合同 基本 信息 " ' 添 加 信息 种 类 第 一 个 项 目 
.Addltem "合同 收费 信息 " ' 添 加 信息 种 类 第 二 个 项 目 

End With 

信息 种 类 .ListIndex = 0 ' 指 定 信 息 种 类 复合 框 默 认 显示 值 

为 运算 符 复合 框 设置 项 目 

With 运算 符 
.Addltem "=" "添加 运算 符 第 一 个 项 目 
.Addltem ">" "添加 运算 符 第 二 个 项 目 
.Addltem "<" "添加 运算 符 第 三 个 项 目 
.Addltem ">=" ' 添 加 运算 符 第 四 个 项 目 
.Addltem "<=" ' 添 加 运算 符 第 五 个 项 四 
.Addltem "<>" "添加 运算 符 第 六 个 项 
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.Addltem "like" "添加 运算 符 第 七 个 项 目 
.Addltem "between" "添加 运算 符 第 八 个 项 目 
End With 
运算 符 .Listindex= 0 ' 指 定 运算 符 复合 框 默 认 显示 值 
End Sub 
Private Sub 关闭 窗 体 _Click() 
cnn.Close ' 关 闭 数据 库 链 接 
Set rs = Nothing ' 清 理 记录 集 对 象 
Set cnn = Nothing ' 清 理 数据 库 连 接 对 象 
Unload 合同 信息 查询 与 导出 ' 拖 载 窗口 
End Sub 


11.10.3 ”复合 框 设置 代码 设计 


在 窗口 中 包含 了 很 多 的 复合 框 , 但 是 只 有 其 中 的 3 个 复合 框 需要 编写 改变 事件 代码 。 这 3 
个 复合 框 分 别 是 信息 种 类 复合 框 、 查 询 项 目 复合 框 和 运算 符 复合 框 。 这 些 复 合 框 的 改变 事件 
的 功能 如 下 : 
口 ”信息 种 类 复合 框 改变 事件 ， 根据 用 户 选 择 的 信息 种 类 ， 从 数据 库 中 获取 对 应 表 的 所 
有 字段 信息 。 这 些 字段 将 作为 查询 项 复合 框 的 项 目 。 
口 查询 项 目 复合 框 改变 事件 ， 根据 用 户 选 择 查询 项 目 ， 从 数据 库 中 获取 当前 查询 条 件 
字段 数据 ， 然 后 将 这 些 数据 添加 到 条 件 1 和 条 件 2 复合 框 中 ， 同 时 清除 在 ListView 
宰 件 中 的 数据 显示 。 
口 运算 符 复合 框 改变 事件 : 当 用 户 选择 了 between 条 件 时 ， 两 个 设置 条 件 的 复合 框 都 应 
该 被 显示 出 来 。 当 用 户 选择 其 他 的 查询 条 件 时 ， 应 该 将 第 二 个 条 件 设 置 复合 框 隐藏 。 
以 下 是 这 3 个 复合 框 的 改变 事件 代码 解释 : 
Private Sub 信息 种 类 _Change() 
On ErrorResume Next 


With 查询 项 目 
.Clear "清除 查询 项 目 复合 框 所 有 项 目 
Set rs = New ADODB.Recordset 
SQL = "select * from " & 信息 种 类 .Value 生成 查询 字符 串 


rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic "获取 查询 记录 集 
Fori= 0 To rs.Fields.Count -1 
.Addltem rs.Fields(i).Name “' 将 记录 集中 所 有 的 字段 名 称 作为 查询 项 目 复合 框 的 项 目 


Next 
End With 
查询 项 目 .ListlIndex = 0 "设置 查询 项 目的 黑 认 显示 值 
Call 清除 显示 信息 "清除 ListView 控件 中 的 显示 
End Sub 


Private Sub 查询 项 目 _Change() 
On Error Resume Next 
Set rs = New ADODB.Recordset 
SQL = "select distinct " & 查询 项 目 .Value & "from " & 信息 种 类 .Value ”' 生 成 查询 字符 串 
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rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 获取 查询 记录 集 


条 件 值 1.Clear "清除 条 件 值 1 复合 框 所 有 项 目 数据 
条 件 值 2.Clear ' 清 除 条 件 值 2 复合 框 所 有 项 目 数据 
Fori= 1 To rs.RecordCount 
条 件 值 1.Addltem rs.Fields( 查 询 项 目 .Value) 为 条 件 值 1 复合 框 添加 项 目 
条 件 值 2.Addltem rs.Fields( 查 询 项 目 .Value) 为 条 件 值 2 复合 框 添加 项 目 
rs.MoveNext ' 将 记录 集 指针 移 到 下 一 条 指针 
Next 
条 件 值 1.ListIndex = 0 "设置 条 件 值 1 复合 框 默 认 值 
条 件 值 2.ListiIndex = 0 "设置 条 件 值 2 复合 框 默认 值 
Call 清除 显示 信息 ' 清 除 ListView 控件 数据 显示 
End Sub 


Private Sub 运算 符 _Change() 
上 f 运算 符 .Value <> "between" Then 
' 当 运算 符 设置 值 不 为 between 时 ， 隐 藏 部 分 控件 


Label_and.Visible = False ' 隐 藏 And 标签 
Label_Value2.Visible = False "隐藏 条 件 值 2 标签 
条 件 值 2.Visible = False "隐藏 条 件 值 2 复合 框 
条 件 值 1.Width = 179 "设置 条 件 值 1 复合 框 宽度 
Else 
' 当 运算 符 设置 值 为 between 时 ， 将 隐藏 控件 显示 出 来 
Label_and.Visible = True "显示 And 标签 
Label_Value2.Visible = True "显示 条 件 值 2 标签 
条 件 值 2.Visible = True "显示 条 件 值 2 复合 框 
条 件 值 1.Width = 79 "设置 条 件 值 1 复合 框 宽度 
End If 
End Sub 


11.10.4 重 设 条 件 按钮 代码 设计 


重 设 条 件 将 所 有 设置 条 件 的 复合 框 控件 设置 为 默认 项 目 ， 并 且 清除 ListView 控件 的 数据 
显示 。 单 击 该 按钮 后 ， 用 户 可 以 对 查询 条 件 重新 进行 设置 。 以 下 是 该 按钮 单 击 事件 过 程 的 代 


码 解释 : 

Private Sub 重 设 条 件 _Click() 
信息 种 类 .ListIndex = 0 ' 设 置信 息 种 类 显示 值 
查询 项 目 .ListiIndex = 0 "设置 查询 项 目 显示 值 
运算 符 .Listindex = 0 "设置 运算 符 显 示 值 
条 件 值 1.Listindex = 0 "设置 条 件 值 1 显示 值 
条 件 值 2.Listlindex = 0 "设置 条 件 值 2 显示 值 
Call 清除 显示 信息 "清除 ListView 控件 显示 

End Sub 


11.10.5 ”开始 查询 按钮 代码 设计 


用 户 在 合同 信息 查询 与 导出 窗口 中 单 击 【 开 始 查 询 】 按 钮 后 ， 程 序 将 按照 用 户 设 置 的 查 
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询 条 件 查询 数据 库 ， 然 后 将 查询 结果 显示 在 获取 查询 字符 串 
ListView 控件 中 。 该 按钮 的 单 击 事件 过 程 流程 生成 查询 记录 集 


图 如 图 11-51 所 示 。 
从 图 中 可 以 看 出 【开始 查询 】 按 钮 完成 的 任 


显示 查询 记录 数据 


有 件 过 程 流程 图 


务 数量 很 少 ， 但 是 其 代码 并 不 简单 。 以 下 是 该 “图 11-51 【开始 查询 】 按 钮 单 击 中 
按钮 单 击 事件 的 代码 解释 : 


Private Sub 开始 查询 _Click() 
Dim SQL As String 
Dim Condition As String, Con0 As String, Con1 As String, Con2 As String 
"设置 查询 条 件 
Con0 = "where " 
lf 查询 项 目 .Value = "签订 日 期 " Or 查询 项 目 .Value = "合同 起 始 日 "__ 
Or 查询 项 目 .Value = "合同 终止 日 " Or 查询 项 目 .Value = "收费 日 期 "Then 
Con1= "W#" & Format( 条 件 值 1.Value, "yyyy-mm-dd") & "可 
Con2 = "#" & Format( 条 件 值 2.Value, "yyyy-mm-dd") & "#" 
Elself 查询 项 目 .Value = "合同 金额 " Or 查询 项 目 .Value = "收费 金额 " Then 
Con1 = Val( 条 件 值 1.Value) 
Con2 = Val( 条 件 值 2.Value) 
Else 
Con1="" & 条 件 值 1.Value &"" 
Con2 ="" & 条 件 值 2.Value & ”" 
End ff 
Condition = "where " & 查询 项 目 .Value 
lf 运算 符 .Value = "between" Then 
Condition = Condition & " between " & Con1 & " and " & Con2 
Elself 运算 符 .Value = "like" Then 
Condition = Condition & " like '%" & 条 件 值 1.Value & "%" 
Else 
Condition = Condition & 运算 符 .Value & Con1 
End ff 
"设置 SQL 语句 
SQL = "select* from " & 信息 种 类 .Value & Condition 
' 开 始 查询 
Set rs = New ADODB.Recordset 
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 
Ifrs.BOF And rs.EOF Then 
MsgBox "没有 查询 到 结果 ! ", vbCritical, "查询 结果 " 
Exit Sub 
End If 
' 将 查询 结果 显示 在 ListView 控件 中 
With ListView1 
"设置 ListView1 的 标题 、 显 示 类 型 、 整 行 选择 和 网 格 线 属性 
.ColumnHeaders.Clear 
-Listltems.Clear 
.View = lvwwReport 
.FullRowSelect = True 
.Gridlines = True 
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' 为 ListView1 设置 标题 

Fori= 0 To rs.Fields.Count -1 
.ColumnHeaders.Add , , rs.Fields(i).Name 

Next i 

为 ListView1 设置 各 行 数据 

.Listltems.Clear 

Fori= 1 To rs.RecordCount 
.Listltems.Add , , rs.Fields(0).Value 
Forj = 1 To rs.Fields.Count -1 

.Listltems(i).Subltems(j) = rs.Fields(j).Value 

Nextj 
rs.MoveNext 

Nexti 

rs.MoveFirst 

End With 
End Sub 


11.10.6 ”数据 导出 按钮 代码 设计 


设置 表 头 及 格式 


写 入 记录 数据 及 格式 


【数据 导出 ] 按 钮 用 于 将 用 户 查询 到 的 记录 

数据 导出 到 单个 的 Excel 文件 中 。 程序 首 先生 成 

-个 新 的 工作 短 , 然后 将 记录 数据 的 表 头 写 入 工 

作 表 中 , 并 设置 格式 ， 最 后 将 记录 数据 依次 写 入 
表 中 。 该 过 程 的 流程 图 如 图 11-52 所 示 。 

以 下 是 该 按钮 单 击 事件 过 程 的 代码 解释 : 图 11-52 【数据 导出 】 按 钮 单 击 事件 过 程 流程 图 


Private Sub 数据 导出 _Click() 
Dim wb As Workbook 
Dim ws As Worksheet 
Dim i As Integer, j As Integer 
Set wb = Workbooks.Add ' 添 加 新 工作 筹 
Set ws = wb.ActiveSheet ' 指 定 写 入 数据 的 工作 表 
With ws 
"设置 表 头 
Fori= 0 To rs.Fields.Count -1 
.Cells(1, i+ 1) = rs.Fields(i).Name ' 将 表 头 写 入 标题 行 对 应 单元 格 中 
Next 
"设置 表 头 格式 
With .Range(Cells(1, 1), Cells(1, rs.Fields.Count)) 
.Font.Bold = True ' 字 体 加 粗 
.HorizontalAlignment = xlCenter "水 平 居中 对 齐 
End With 
' 写 入 记录 数据 
Fori= 1 To rs.RecordCount 
Forj = 0 To rs.Fields.Count -1 
.Cells(i+ 1,j+ 1) = rs.Fields() ' 将 记录 字段 数据 写 入 对 应 单元 格 中 
If rs.Fields().Type = adDate Then 


a39 


办 公 应 用 齐 党 乞 比 - 
Excel VBA 应 用 开发 经 典 案例 


.Cells(i + 1,j + 1).NumberFormat = "yyyy-mm-dd" "设置 日 期 型 记录 数据 


的 显示 格式 
End If 
Ifrs.Fields(j).Type = adCurrency Then 
.Cells(i + 1,j + 1).NumberFormat = "#,##0.00" "设置 货币 型 记录 数据 
的 显示 格式 
End If 
Next 
rs.MoveNext ' 将 记录 指针 移动 到 下 一 条 
Next i 
.Columns.AutoFit ' 列 自动 对 齐 
End With 
Set ws = Nothing "清除 工作 表 对 象 临时 变量 
Set wb = Nothing ' 清 除 工 作 簿 对 象 临时 变量 
End Sub 


11.10.7 ”清除 显示 信息 过 程 代码 设计 


清除 显示 信息 过 程 用 于 将 ListView 的 显示 数据 进行 重 署 。 这 些 数据 包括 了 该 控件 的 标题 
项 目 以 及 数据 显示 项 目 。 以 下 是 该 自 定 义 过 程 的 代码 解释 : 
Public Sub 清除 显示 信息 () 
With ListView1 


.ColumnHeaders.Clear "清除 控件 所 有 标题 
.Listltems.Clear ' 清 除 控件 所 有 数据 项 目 
.View = IvwReport ' 定 义 控 件 显示 模式 
.FullRowSelect = True ' 允 许 整 行 选择 
.Gridlines = True ' 显 示 网 格 线 
End With 
End Sub 


11.11 系统 测试 


当 该 文件 被 打开 时 ， 系 统 会 自动 弹出 登录 窗口 。 当 然 可 以 不 输入 任何 登录 信息 ， 但 是 用 
户 将 不 能 完成 合同 基本 信息 管理 、 合 同 收费 信息 管理 和 合同 信息 查询 与 导出 3 部 分 的 工作 。 
本 系统 的 功能 基本 上 是 通过 窗口 实现 的 ， 系 统 共 包含 了 6 个 窗口 ， 下 面 将 分 5 个 部 分 分 别 测 
试 这 5 个 窗口 的 功能 。 


11.11.1 登录 窗口 测试 


本 系统 只 有 登录 后 才能 打开 相应 的 合同 管理 工作 短 ， 和 否则 无 法 打开 3 个 合同 管理 窗口 。 
要 登录 工作 筹 ， 操 作 步 骤 如 下 : 
(1) 找到 该 工作 短文 件 或 在 系统 的 首页 单 击 【登录 系统 】 按 钮 后 ， 将 弹出 【用 户 登 录 】 


Ah 
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对 话 框 (如 图 11-53 所 示 ) 。 

(2) 系统 只 建立 一 个 用 户 与 密码 。 第 一 次 运行 时 , 在 【用 户 名 】 文 本 框 中 输入 “admin”， 
在 【密码 】 文 本 框 中 输入 “123456”， 然 后 单 击 【进入 系统 】 按 钮 。 
当 用 户 输入 了 错误 的 用 户 名 或 者 错误 的 密码 ， 系 统 将 自动 退出 。 在 退出 之 前 ， 系 统 会 弹 
出 一 个 错误 提示 框 告知 用 户 用 户 名 和 密码 错误 (如 图 11-54 所 示 ) 。 


EE Ee xl 
PS:Cemm J) | (LAs ]) @ 用 户 各 和 密码 不 存在 4 
sm mma | [re 


图 11-53 【用 户 登 录 】 对 话 框 图 11-54 错误 提示 框 


11.11.2 ”修改 用 户 名 窗口 测试 


用 户 在 登录 与 未 登录 到 系统 的 状态 下 ， 都 可 以 完成 用 户 名 的 修改 操作 。 要 完成 修改 用 户 
名 操作 ， 用 户 需 要 在 【修改 用 户 名 】 对 话 框 中 输入 3 条 信息 ， 分 别 是 原 用 户 名 、 新 用 户 名 和 
用 户 密码 。 修 改 用 户 名 的 操作 过 程 如 下 : 

(1) 在 首页 中 单 击 【修改 用 户 名 】 按 钮 ， 打 开 【 修 改 用 户 名 】 对 话 框 。 

(2) 在 【 原 用 户 名 】、【 新 用 户 名 】 和 【密码 】 文 本 框 中 分 别 输入 相应 信息 ， 然 后 单 击 


【确定 】 按 钮 (如 图 11-55 所 示 ) 。 


(3) 用 户 输入 错误 密码 后 ， 系 统 会 弹出 


-提示 框 ( 如 图 11-56 所 示 〉。 单 击 【 确 定 】 按 


钮 后 ，【 修 改 用 户 名 】 对 话 框 的 【密码 】 文 本 框 数 据 被 清除 。 此 时 的 鼠标 焦点 也 将 处 于 该 文 


本 框 中 (如 图 11-57 所 示 ) 。 


(4) 当 用 户 输入 密码 正确 时 ， 系 统 将 保存 该 用 户 名 修改 结果 ， 并 提示 用 户 修改 成 功 〈 如 


图 11-58 所 示 ) 。 
EE 

原 用 户 各 : 

MPS: (ee ) 

Tm 


密码 : 

mm | 

图 11-55 【修改 用 户 名 】 对 话 框 
可 


原 用 户 名 : aanin 


新 用 户 名 : nest 


”CD 


ee] mw | 


11-57 ” 重 设 修改 用 户 名 密码 


[EC 
3 enkiat 
于 


图 11-56 修改 用 户 名 密码 错误 


到 
动 用 户 名 修改 成 功 4 请 记 好 你 的 新 用 户 各 + 


图 11-58 ”修改 用 户 名 成 功 
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Excel VBA 应 用 开发 经 典 案例 


11.11.3 ”修改 用 户 密码 窗口 测试 


用 户 在 登录 与 未 登录 到 系统 的 状态 下 ， 都 可 以 完成 用 户 密码 的 修改 操作 。 要 完成 修改 用 


户 密码 操作 ， 用 户 需 要 在 【修改 密码 】 对 话 框 中 输入 3 条 信 
息 ， 分 别 是 用 户 名 、 原 密码 和 新 密码 。 修 改 用 户 密码 操作 的 


过 程 如 下 : 
(1) 在 首页 单 击 【修改 用 户 名 】 按 钮 , 打开 【修改 密码 】 


(2) 在 【用 户 名 】、【 原 密码 】 和 【新 密码 】 文 本 框 中 
分 别 输入 相应 信息 ， 然 后 单 击 【 确 定 】 按 钮 (如 图 11-59 所 


Ei 


11.11.4 合同 信息 管理 窗口 测试 


图 11-59 【修改 密码 】 对 话 框 


在 本 节 的 测试 过 程 中 ， 不 涉及 窗口 中 的 浏览 按钮 。 这 里 讲述 的 主要 是 该 窗口 中 的 【新 合 
同 】、【 添 加 】、【 修 改 】、【 删 除 】 以 及 【查询 】 按 钮 的 操作 。 测 试 该 窗口 的 过 程 如 下 : 

(1) 在 首页 单 击 【 合 同 基本 信息 管理 】 按 钮 ， 弹 出 【合同 基本 信息 管理 】 对 话 框 ， 然 后 
在 该 对 话 框 中 单 击 【新 合同 】 按 钮 ， 此 时 效果 如 图 11-60 所 示 。 


合同 基本 信息 管理 
同 基本 信 | 


E53 收费 类 别 收费 日 册 [收费 全 寅 [各 证 
[El 艺 | 
3 村 吾 用 可 


图 11-60 【合同 基本 信息 管理 】 对 话 框 


(2) 在 合同 基本 信息 框架 中 输入 合同 必需 信息 (如 图 11-61 所 示 ) ， 单 击 【 添 加 】 按 钮 ， 
在 随后 弹出 的 【添加 记录 】 询 问 框 (如 图 11-62 所 示 ) 中 单 击 【是 】 按 钮 ， 即 可 将 新 合同 记录 
添加 到 数据 库 中 。 添 加 完成 后 ， 窗 口中 显示 的 该 记录 并 不 是 新 添加 的 记录 。 要 查看 该 记录 ， 


可 以 单 击 【 最 末 条 】 按 钮 ， 也 可 以 单 击 【 查 询 】 按 钮 。 
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EE 
广 合同 基本 信息 
EL [nanas 合同 类 别 [HS 同 可 ms 


项 目 名 称 后 未 下 NAAS 可 大庆 二 
委托 单位 [后 家 下 AAS 司 


联系 人 信 宇 联系 电话 [51165555555 

E73 等 订 部 门 夺目- 训 7 _#] 
往日 期 [as-10-55 合同 起 类 日 |006-10-25 。。 合同 终 止 日 07-10-55 
合同 全 富 [an660 人 fom A 


| 远 加 记录 
\2) a 
< sw | 
图 11-61 添加 新 合同 信息 记录 图 11-62 确认 添加 新 合同 
(3) 单 击 【 查 询 】 按钮 ， 在 随后 弹出 的 合同 号 输入 框 中 
输入 “LWH0003”， 然 后 单 击 【 确 定 】 按 钮 (如 图 11-63 所 
示 )。 此 时 窗口 中 将 会 立即 显示 该 新 添加 合同 的 合同 基本 信息 。 
(4) 在 该 新 添加 的 合同 中 ， 对 联系 电话 做 出 修改 。 这 里 
将 联系 电话 修改 为 “0311-66666666”， 然 后 单 击 【 修 改 】 按 。” 图 11-63 ”输入 查询 合同 号 
钮 。 修 改 成 功 后 弹出 一 提示 框 ， 告 知 用 户 合同 记录 修改 成 功 ， 确 认 即 可 。 
(5) 单 击 【 浏 览 】 按 钮 ， 确 保 当 前 窗口 显示 的 合同 记录 即 为 前 面 修 改 的 记录 ， 然 后 单 击 
【删除 】 按 钮 ， 此 时 该 记录 将 从 数据 库 中 被 删除 。 随 后 会 弹出 一 提示 框 告知 用 户 该 记录 已 经 
被 删除 ， 单 击 【确定 】 按 钮 即 可 。 
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11.11.5 合同 收费 信息 管理 窗口 测试 


合同 收费 信息 管理 窗口 中 很 多 按钮 和 合同 基本 信息 管理 窗口 按钮 类 似 ， 并 且 操 作 上 也 相 
差 不 大 。 这 里 只 对 修改 按钮 与 添加 新 收费 类 别 的 操作 步骤 加 以 测试 ， 其 他 按钮 的 功能 请 读者 
自己 测试 。 该 演示 的 测试 是 将 CADT00001 号 合同 的 第 一 条 收费 信息 中 的 收费 类 别 为 “预付 款 ”。 
笔者 先前 将 数据 库 中 收费 类 别 的 “预付 款 ” 已 经 删除 ， 因 而 这 里 还 需要 新 添加 “预付 款 ” 收 
费 类 别 。 测 试 过 程 如 下 : 

(1) 在 首页 单 击 【 合 同 收费 信息 管理 】 按 钮 ， 弹 出 【合同 收费 信息 管理 】 对 话 框 (如 
图 11-64 所 示 ) 

(2) 在 【收费 类 别 】 复 合 框 中 输入 新 收费 类 别 【 预 付款 】， 然 后 单 击 【添加 类 别 】 按 
钮 (如 图 11-65 所 示 ) 。 随 后 会 弹出 一 提示 添加 成 功 的 提示 框 ， 单 击 【 确 定 】 按 钮 即 可 〈 如 
图 11-66 所 示 ) 。 当 用 户 再 次 选择 【收费 类 别 】 复 合 框 右 侧 的 下 拉 列 表 框 时 ， 此 时 将 会 显示 预 
付款 的 选项 供用 户 选择 〈 如 图 11-67 所 示 ) 。 

(3) 在 【合同 收费 信息 管理 】 窗 口 单 击 【 修 改 】 按 钮 ， 程 序 将 自动 保存 用 户 在 前 面 做 出 
的 收费 类 别 修改 操作 。 


四 
三 合同 收费 信息 一 一 新 记录 
上 
FE 
型 除 
查询 
退出 
二 
| 
些 到 


图 11-64 【合同 收费 信息 管理 】 对 话 框 


[me | 


ADYOOOOT 2006-11-20 S00000 
CADYD0001 两 2007-5-12 1000000 
。 CADYO001 2007-12-25 500000 
JU hep 
[Wi 4 


图 11-66 ”添加 类 别 成 功 图 11-67 新 收费 类 别 被 添加 


11.11.6 ”合同 信息 查询 与 导出 窗口 测试 


在 【合同 信息 查询 与 导出 】 窗 口中 可 以 完成 合同 基本 信息 与 收费 信息 的 查询 与 导出 工作 。 
这 里 只 介绍 合同 基本 信息 的 查询 与 导出 测试 操作 。 


(1) 在 首页 单 击 【 合 同 信息 查询 与 导出 】 按 钮 ， 打 开 【 合 同 信息 查询 与 导出 】 窗 口 (如 
图 11-68 所 示 ) 。 


四 
一 选择 要 查询 的 信息 种 闪 和 设置 全 光 条 人 


选择 要 查询 的 信息 种 类 [合同 基地 信息 -| | 
人 Cy 省 

查询 项 目 运算 符 条 件 值 1 件 值 2 
届 A em de || ee | 
El| 


合同 号 各: 联系 人 

ns RE P| 

Gr30944¢ 北京 人 和 信息 -北京 人 有 信息 .三 欣欣 010-88388883 。 2005-10-15 ”也 

Lpoo3 下 荣 语 WA 公 石家庄 AAA 公司 “ 音 宏 91I-65666656 “2006-10-25 天 妆 
避 


图 11-68 ”查询 合同 信息 
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(2) 在 选择 查询 的 信息 种 类 中 选择 【合同 基本 人 信息】 项目， 在 【查询 项 目 】 复 合 框 中 选 
择 【 合 同 号 】 项 目 ， 在 【运算 符 】 复 合 框 中 选择 between。 随 后 在 【条 件 值 1】 和 【条 件 值 2】 
复合 框 中 分 别 设置 合同 号 为 “CADTY00001” 和 “LWH0003”， 最 后 单 击 【 开 始 查询 】 按 钮 。 
此 时 所 有 的 查询 结果 被 显示 在 窗口 下 方 的 ListView 控件 中 。 

(3) 在 窗口 中 单 击 【数据 导出 】 按 钮 ， 程 序 将 新 建 一 个 工作 筹 ， 并 将 查询 所 得 记录 集 的 
数据 复制 到 该 工作 秒 的 工作 表 中 (如 图 11-69 所 示 ) 


国 5o02 x 
| me | Ee 
同 号 项 目 名 称 天 最 对 请 和 电话 签订 日 期 
2 CADYD000L 邢 姐 300 轧 机 襄 i 开机 地 渔 。 0319-8868888 2006-09-2| 
gccBo9s44 站 下 信息 二 公司 Exp 人 王 欣 秋 010-88888386 2005-10-1| 
LWHOD03 。 石家庄 AAA 公 司 提 纪 设 计 章 实 。 0311-B66656E6 2006-10-2| 


MM Sheot!ls Sheot? shent3 7 


图 11-69 导出 查询 结果 


第 12 章 ” 拆 分 与 备份 工作 簿 系统 


拆 分 与 备份 工作 德 系统 是 一 个 能 运行 在 Excel 2007 下 的 工作 短工 具 系统 ， 通 过 本 系统 的 
拆 分 模块 可 以 将 包含 多 个 工作 表 的 工作 短 按 照 用 户 的 组 别 设置 保存 到 新 的 工作 矢 中 。 备 份 模 
块 可 以 将 原来 分 散 到 各 个 工作 夭 中 的 部 分 工作 表 合 并 到 一 个 新 的 工作 短 中 。 本 工具 系统 是 笔 
者 开发 的 办 公 工 具 作 品 之 一 ， 系 统 采用 加 载 宏 的 形式 。 用 户 可 以 将 该 加 载 宏 安装 到 自己 的 
Excel 2007 中 ， 以 后 每 次 打开 Excel 2007 都 会 在 加 载 项 菜单 中 找到 该 工具 的 开启 菜单 。 


12.1 系统 概述 


从 该 系统 的 名 称 上 可 以 看 到 ， 本 系统 只 包含 了 拆 分 工作 敌 和 备份 工作 短 两 个 功能 。 拆 分 
工作 敌 是 将 某 工 作 短 中 的 工作 表 分 别 保存 到 各 个 
工作 敌 中 ,原来 的 工作 敌 并 不 发 生变 更 。 备份 工作 
簿 是 将 原来 分 属 不 同 工 作 敌 的 工作 表 合并 到 同一 
个 工作 敌 。 原来 笔者 命名 该 系统 时 是 以 拆 分 和 合并 
工作 敌 为 名 称 的 。 

该 系统 的 架构 十 分 简单 。 在 拆 分 工作 适时 ， 首 
先 获取 源 工作 短 , 然后 在 设置 需要 拆 分 出 来 的 工作 
表 ， 最 后 保存 拆 分 工作 禾 。 备 份 工 作 短 时 ， 首 先 选 
择 备 份 源 工作 禾 ,， 然后 选择 需 备份 的 工作 表 ， 最 后 
保存 备份 工作 禾 。 该 系统 的 框架 结构 图 如 图 12-1 
所 示 。 


泪 洲 区 认 口 定 家 是 汪 算 


图 12-1 拆 分 与 备份 工作 血 系 统 框架 结构 图 


12.1.1 设计 思 


拆 分 与 备份 工作 短工 具 系统 一 共 完 成 两 个 任务 : 拆 分 单个 工作 短 的 工作 表 到 新 工作 短 和 
合并 各 个 工作 短 的 工作 表 到 新 工作 敌 中 。 前 一 个 功能 由 一 个 窗 体 完成 ， 后 一 个 功能 由 4 个 窗 
体 完成 。 以 下 是 这 些 窗 体 的 功能 介绍 : 
口 “Frm 拆 分 工作 短 : 在 该 窗 体 中 ,用 户 可 以 设置 需要 拆 分 的 工作 德 的 路 径 ， 然 后 对 各 个 
表 进 行 分 组 。 分 组 的 名 称 将 作为 其 新 工作 短 的 名 称 。 用 户 还 可 以 在 该 窗 体 下 对 分 组 
内 所 包含 的 工作 表 进行 调整 ， 最 后 通过 拆 分 按钮 实现 拆 分 工作 。 

口 ”Frmm 选择 工作 禾 : 该 窗 体 主要 是 选择 需要 合并 工作 表 的 工作 短 , 在 该 窗 体 下 用 户 可 以 
一 次 选择 多 个 工作 短 的 名 称 。 选 择 完成 之 后 ， 用 户 还 可 以 再 次 确认 最 终 真 正 需要 的 
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工作 竹 。 只 有 被 选中 的 工作 簿 才 会 被 系统 记录 到 下 一 步 的 表 调整 操作 中 。 
口 、Frm 选择 工作 表 : 该 窗 体 中 ， 用户 可 以 确定 所 有 需要 合并 的 工作 表 。 这 些 工作 表 属 于 
先前 被 选中 的 工作 敌 。 
口 Frm 保存 位 置 : 该 窗 体 中 主要 用 于 完成 设置 保存 文件 位 置 并 开始 合并 备份 工作 。 它 还 
可 以 显示 出 所 有 已 经 确定 合并 的 工作 表 及 所 属 工作 短 的 位 置信 息 ， 以 便于 用 户 回 到 
上 一 步 做 出 调整 。 
口 ”Frm 提示 信息 : 该 窗 体 用 于 显示 一 些 提示 信息 。 
系统 只 包含 了 一 个 公共 模块 。 公 共 过 程 与 函数 不 多 ， 因 而 将 所 有 的 公共 变量 、 过 程 和 函 
数 都 保存 在 同一 个 模块 中 。 程 序 中 数据 的 保存 是 通过 数据 库 实现 的 。 但 是 其 中 关于 中 英文 显 
示 界 面 的 实现 部 分 的 数据 保存 在 工作 表 中 ， 关 于 这 部 分 内 容 ， 请 参见 后 续 详 细 介 绍 。 


12.1.2 ”知识 点 一 : 在 Excel 2007 中 装载 加 载 宏 


在 Excel2007 中 ， 标 准 加 载 宏 文件 的 后 级 名 称 为 .xlam。 这 些 加 载 宏文 件 可 以 随同 
Excel 2007 一 同 装载 。 当 确认 装载 这 些 文件 后 ， 每 次 开启 Excel 2007 程序 ， 该 加 载 宏 都 会 自动 
开启 。 要 让 加 载 宏文 件 能 随 Excel 2007 程序 一 同 加 载 ， 可 按照 以 下 步骤 设置 ， 

(1) 单 击 Excel 2007 左上 方 的 Office 菜单 按钮 图 标 ， 在 随后 弹出 的 菜单 中 单 击 【Excel 
选项 】 按 钮 ， 如 图 12-2 所 示 。 

ww 
DD 新 建 IJ ee 
a 工 拆 分 与 备份 工作 要 xlam 
苹 HQ 2 国定 资产 明 归 账 xs 


可 2 4 人 事 栖 守 As 
网 5 学 生成 管理 系统 -xm 
i 


Bookixsm 


进 稍 存 管理 系统 xsm 
Bookixsm 

客户 信息 管理 系统 Xs 
msx 
客户 管理 系统 :sm 
—_ V3lllOxls 


12-2 打开 【Excel 选项 】 


(2) 在 【Excel 选项 】 窗 口中 (如 图 12-3 所 示 ) ， 选 择 【 加 载 宏 】 项 目 。 在 其 右 侧 底 剖 
找到 【管理 】 复 合 框 ， 选择 【Excel 加 载 项 】 选 项 ,然后 单 击 其 右 侧 的 【 转 到 】 按 钮 ， 打 开 【 加 
载 宏 】 管 理 窗口 。 

(3) 在 【加 载 宏 】 管 理 窗 口中 (如 图 12-4 所 示 〉， 单 击 【 浏 览 】 按 钮 。 找 到 需要 自动 加 
载 的 加 载 宏文 件 并 选择 该 文件 ， 随 后 该 文件 的 文件 名 将 被 添加 到 【可 用 加 载 宏 】 列 表 框 中 。 


wm 
| 
Wl 


Aa4a7 


在 该 列表 框 中 选择 已 经 添加 到 管理 器 中 的 加 载 宏文 件 并 单 击 【确定 】 按 钮 即 可 。 


12.1.3 ”知识 点 二 : 


在 本 实例 中 
窗口 列表 控件 中 。 要 获取 这 些 信息 ， 通 过 ADO 对 象 比 较 困 难 。 这 里 使 用 


xl 
|: 动 本 管理 Micosof Office ji 要 项 -AN 
加 要 现 

E33 IE E73 
0 
Chinese Translaton Addin DN.Office\Office12WADDINS\TCSCCONV.DLL COM 加 戴 项 
loffice Special Symbol Input Add-in DA..Office\Office12WADDINS\SYMINPUT.DLL ”COM 加 本 项 
Snaglt Add-in CechSsmith\Snagft 8\SnagltofficeAddin dl 《COM 加 忒 项 
与 备份 工 FN 并 分 与 备份 工作 表 \ 拆 分 与 备份 工作 表 xlam 。 ExXcel 加 茵 项 

非 活动 应 用 程序 加 堪 顶 

Internet Assistant VBA DAtools\Office\Office12\Uibra\HTMLXLAM Excel 加 载 项 
标签 打印 向 导 Di\.icel2\Libra\Label Print\labelprintxlam Excel 加 载 项 
不 可 见 内 容 Di\tools\Office\Office12\OFFRHD.DLL 文档 检 刘 器 
互 两 内 导 lookup.xlam Excel 加 载 项 
分 析 工 具 库 analys32.x| Exce| 加 匣 项 
分 析 工具 库 - VBA 有 xdam Exce| 加 茵 项 
规划 求解 bn 酸 项 Excel 加 哉 项 
EI Excel 加 吉 硕 
| 人 各 (Outlook 电 于 部 件 收 件 人 ) Cerosoft Shared\smart Tag\FNAME.DLL 。 知 甬 奈 沁 
日 其 上 者 能 村 列表 ) CAMicrosoft shared\smart Taq\MOFL.DLL a 御用 Fi 加 
加 由 大 Chinese Translaton Addin 

发 布 者 : -Microsoft Corporation 

位 置 Di\tools\Office\Officel2\ADDINS\TCSCCONV.DLL 

说 明 :COM addin that translates between Traditional Chinese and Simplifled Chinese. 

[evce mm 

ww | 


图 12-3 ”加载 项 设置 
可 可 


图 12-4 


使 用 ADOX 库 


【加 载 宏 】 管 理 窗口 


， 需 要 快速 确定 工作 敌 中 包含 的 工作 表 ， 并 且 要 将 这 些 工作 表 的 名 称 体现 在 


了 ADO 的 一 个 扩展 


库 ADOX， 通 过 使 用 该 对 象 库 的 Catalog 和 Table 对 象 可 以 迅速 确定 工作 竹中 包含 的 工作 表 及 
名 称 。 调 用 该 对 象 库 的 方法 如 下 : 


在 VBE 开发 环境 中 依次 选择 【工具 】|【 引 用】 命令 (如 图 12-5 所 示 ) ， 


打开 【引用 】 


对 话 框 ,在 该 对 话 框 中 找到 Microrsoft ADO Ext.2.8 For DLL and Security 的 引用 (如 图 12-6 所 
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示 ) 。 选 中 该 复 选 框 后 ， 单 击 【 确 定 】 按 钮 即 可 。 关 于 该 对 象 库 的 使 用 方法 ， 请 见 后 续 章节 
的 介绍 。 


引用 G)- 

选项 (@).. ft AD0 Ext. 2.8 for DIL and secrity 一 一 
VBAProject 履 性 加. ee Files\Comnon Files\systenVaaowmsadox .本 
数字 答 名 (D)… 


图 12-5 引用 菜单 图 12-6 引用 ADOX 对 象 库 
12.2 数据库 表 设计 


系统 中 几乎 大 部 分 的 临时 数据 都 保存 在 了 数据 库 表 中 。 该 数据 库 通 过 Access 2007 建立 ， 
该 文件 被 保存 为 “临时 数据 .accdb”， 读 者 可 以 在 随 书 光盘 中 找到 该 文件 。 在 该 数据 库 中 包含 
了 4 个 数据 表 ， 分 别 是 拆 分 表 、 拆 分 表 组 别 、 工 作 表 和 工作 短 。 这 4 个 表 的 作用 分 别 如 下 : 
口 拆 分 表 : 该 表 用 于 记录 需 拆 分 的 工作 短 中 所 有 表 的 分 组 情况 。 当 执行 拆 分 时 ， 该 表 
保存 的 信息 决定 了 拆 分 的 方式 ， 即 工作 短 中 各 个 工作 表 的 归属 情况 。 
口 ” 拆 分 表 组 别 ， 该 表 存 储 非 重复 的 工作 表 分 组 信息 。 这 些 分 组 名 称 最 终 会 成 为 各 个 拆 
分 工作 短 的 名 称 〈 不 包含 工作 短 的 后 级， 后 绥 取 原文 件 的 后 缀 ) 。 而 各 个 工作 表 在 
拆 分 时 ， 将 按照 拆 分 表 信 息 依次 归 入 各 个 新 工作 竹中 。 
工作 夭 : 该 表 保 存 的 是 用 户 在 备份 工作 短 窗 口中 打开 的 所 有 工作 短 的 路 径 与 名 称 信 
息 等 。 该 表 的 信息 包含 了 用 户 选 中 和 未 选中 的 所 有 工作 德 资料 。 
口 工作 表 : 该 表 包含 了 所 有 用 户 选 定 合并 备份 的 工作 表 的 表 名 和 所 属 工作 短路 径 信息 。 
表 12-1~ 表 12-4 以 表格 的 形式 说 明 这 些 表 的 字段 结构 设计 情况 。 此 处 不 再 具体 说 明 在 
Access 2007 中 建立 这 些 表 的 过 程 。 如 果 读者 对 此 不 很 明了 ， 可 以 参见 9.2 节 具 体内 容 。 


口 


表 12-1 拆 分 表 字 段 设 计 


字段 名 称 是 否 允许 为 空 
[ 作 表 名 文本 是 
组 名 是 
表 12-2 拆 分 表 组 别 字 段 设计 
字段 名 称 
组 名 


字段 名 称 
工作 短路 径 
工作 表 名 


字段 名 称 是 否 允 许 为 空 
工作 夭 路 径 是 
工作 矢 名 是 


12.3 工作 簿 与 公共 模块 代码 设计 


工作 德 对 象 和 公共 模块 中 包含 的 代码 大 多 都 是 完成 系统 公用 变量 定义 或 公共 设置 。 了 解 
该 部 分 的 代码 设计 有 利于 搞 清楚 系统 整体 设计 与 程序 运行 的 流程 。 该 节 介 绍 的 部 分 过 程 和 函 
数 将 被 其 他 窗 体 或 过 程 调用 ， 在 阅读 后 续 章 节 时 ， 读 者 可 能 需要 重新 回 到 本 节 参 阅 公共 函数 
或 过 程 的 代码 。 因 此 ， 这 里 将 这 部 分 代码 的 说 明 放 在 本 章 的 前 端 。 

工作 德 对 象 的 事件 代码 十 分 简单 ， 但 公共 模块 代码 较 长 。 后 续 小 节 将 把 公共 模块 的 所 有 
过 程 和 函数 单独 列 出 加 以 介绍 。 


12.3.1 工作 敌对 象 代码 设计 


工作 敌对 象 中 的 代码 只 包含 了 两 个 事件 代码 。 这 两 个 事件 的 代码 并 不 长 ， 这 里 将 不 对 这 
些 代码 分 开 介绍 。 其 功能 描述 如 下 : 
口 工作 簿 开启 事件 ， 工作 敌 开 启 时 ， 需 要 完成 的 工作 包括 数据 库 链 接 的 设置 、 系 统 菜 
单 的 设计 。 工 作 短 一 打开 ， 程 序 将 立即 链接 到 “临时 数据 .accdb” 数 据 库 文件 ， 该 链 
接 被 保存 在 公共 变量 “cnn 临时 数据 短 ” 中 。 
口 工作 短 关 闭 事件 ， 和 工作 筹 开 启事 件 相对 应 。 关 闭 工 作 敌 时， 需要 清除 系统 建立 的 
菜单 系统 并 且 断 开 数据 库 链接 。 
以 下 是 这 两 个 事件 过 程 的 代码 解释 : 
Private Sub Workbook_Open() 
Dim objMenu As CommandBarPopup, itemMenu As Object 


打开 数据 库 链 接 

cnn 临时 数据 簿 .Open GetConnString(ThisWorkbook.Path & "\ 临 时 数据 .accdb") 

cnn 临时 数据 簿 .Execute "delete * from 工作 簿 " "删除 工作 短 表 中 保存 的 数据 

cnn 临时 数据 敌 .Execute "delete * from 工作 表 " "删除 工作 表 中 保存 的 数据 

为 系统 建立 莱 单 

Set objMenu = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, _ 
before:=10, temporary:=True) ' 添 加 一 级 菜单 对 象 


objMenu.Caption = "工作 筹 拆 分 与 备份 " "设置 一 级 菜单 Caption 属性 
"添加 拆 分 工作 簿 菜单 


Set itemMenu = objMenu.Controls.Add(Type:=msoControlButton) "添加 第 一 个 二 级 菜单 按钮 
itemMenu.OnAction = "显示 拆 分 窗口 " "设置 第 一 个 二 级 菜单 按钮 执行 过 程 
itemMenu.Caption = " 拆 分 工作 简 " "设置 第 一 个 二 级 菜单 Caption 属性 
' 添 加 备份 工作 秒 菜 单 

Set itemMenu = objMenu.Controls.Add(Type:=msoControlButton) "添加 第 二 个 二 级 菜单 按钮 
itemMenu.OnAction = "显示 备份 窗口 " "设置 第 二 个 二 级 菜单 按钮 执行 过 程 
itemMenu.Caption = "备份 工作 简 " "设置 第 二 个 二 级 菜单 Caption 属性 
Set objMenu = Nothing "清除 objMenu 变量 

Set itemMenu = Nothing "清除 iemMenu 变量 

End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 

On Error Resume Next "发 生 错 误 时 继续 执行 下 一 条 语句 
Application.CommandBars(1).Controls(" 工 作 筹 拆 分 与 备份 ").Delete 删除 

On Error GoTo 0 "恢复 默认 错误 处 理 机 制 

Set cnn 临时 数据 往 = Nothing 

End Sub 

代码 说 明 : 


在 工作 秒 打 开 事 件 过 程 中 ， 打 开 数 据 库 链接 时 ， 使 用 了 一 个 GetConnString 自 定义 函数 。 
该 函数 接受 一 个 数据 库 文件 的 绝对 地 址 ， 然 后 返回 一 个 完整 的 链接 到 该 数据 库 文件 的 链接 字 
符 吊 。 


12.3.2 ”公共 变量 与 菜单 按钮 代码 设计 


本 小 节 介绍 的 是 公共 模块 中 所 有 公共 变量 的 实际 意义 和 菜单 按钮 的 过 程 代 码 。 这 部 分 内 
容 是 公共 模块 中 较为 简单 的 部 分 ， 代 码 也 比较 少 ， 因 而 归纳 为 一 类 加 以 介绍 。 以 下 是 该 部 分 
的 代码 解释 : 

Public languageset As Boolean ' 设 定语 言 种 类 

获取 在 选择 工作 簿 窗口 中 打开 工作 筹 的 路 径 字 符 串 ， 由 于 允许 选择 多 个 文件 ， 因 此 该 变量 可 能 是 一 个 数 

组 ， 这 里 设 定 该 变量 的 数据 类 型 为 Variant 

Public arr 选择 工作 簿 As Variant 


获取 需 拆 分 工作 往 的 路 径 ， 由 于 设 定 了 不 允许 选择 多 个 文件 ， 所 以 固定 该 变量 的 参数 为 字符 串 
Public str 拆 分 工作 简 As String 


Public cnn 主 工作 短 As New ADODB.Connection ' 到 本 工作 簿 的 链接 对 象 
cnn 临时 数据 往 As New ADODB.Connection ' 到 数据 库 文件 的 链接 对 象 
Public rs As New ADODB.Recordset 数据 库 记 录 集 对 象 
Public Sub 显示 拆 分 窗口 () 

frm 拆 分 工作 短 .Show "显示 拆 分 工作 簿 窗口 

End Sub 


Public Sub 显示 备份 窗口 () 
frm 选择 工作 簿 .Show ' 显 示 选 择 工作 筹 窗口 
End Sub 
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12.3.3 ”刷新 窗 体 语言 显示 过 程 代码 设计 


刷新 窗 体 语言 显示 过 程 是 一 个 通用 的 窗 体 语 言 显 示 刷 新 过 程 。 当 语言 显示 设置 发 生 改变 
时 ， 对 于 所 有 的 控件 而 言 ， 需 要 修改 的 只 是 控件 的 Caption 属性 。 在 本 加 载 安 工作 短 中 存在 一 
个 唯一 的 表 ， 该 表 保 存 了 语言 显示 的 数据 资料 。 该 表 包 含 3 个 字段 信息 ， 分 别 是 控件 的 名 称 
CName) 、 语 言 设置 为 英文 时 应 该 显示 的 字符 (EnglishString) 、 语 言 设置 为 中 文 时 应 该 显示 
的 字符 〈ChineseString) 。 

当 进入 刷新 过 程 后 ， 程 序 接受 了 一 个 窗口 对 象 参 
数 。 再 根据 语言 设置 获取 所 有 记录 的 两 个 字段 数据 ， 一 
个 是 控件 名 称 ， 一 个 是 对 应 语言 设置 的 字段 。 然 后 程序 
根据 指定 的 控件 名 ， 在 记录 集中 找到 对 应 控件 当前 语言 
设置 下 显示 的 字符 串 。 对 于 窗 体 和 窗 体 中 的 控件 操作 都 
是 一 样 ， 不 同 的 是 对 于 窗 体 中 的 控件 可 以 使 用 循环 来 实 
现 逐 个 修改 显示 信息 。 

如 图 12-7 所 示 的 是 该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 代码 解释 : 

Public Sub 刷新 窗 体 语 言 显示 (formObject As Object) 


记录 集中 查找 当前 窗 体 
的 标题 显示 字段 
设置 窗 体 的 标题 
循环 窗 体 控件 ， 

设置 控件 标题 


图 12-7 刷新 窗 体 语言 显示 过 程 流程 图 


On Error Resume Next "代码 发 生 错 误 时 继续 执行 下 一 条 语句 
rs.Close "关闭 rs 记录 集 对 象 ， 以 免 发 生 重用 错误 
On Error GoTo 0 "恢复 默认 错误 处 理 机 制 


' 根 据 语言 设置 变量 ， 获 取 指 定语 言 设置 下 对 应 记录 集 
lflanguageset Then 


"获取 控件 名 称 和 英文 显示 字段 数据 

rs.Open "select Name,EnglishString from [语言 设置 $]", cnn 主 工作 簿 , adOpenKeyset， 
adLockOptimistic 
Else 

"获取 控件 名 称 和 中 文 显示 字段 数据 

rs.Open "select Name,ChineseString from [语言 设置 $]", cnn 主 工作 往 , adOpenKeyset， 
adLockOptimistic 
End If 
On Error Resume Next 
rs.Find "Name=" & formObject.Name & "" ' 在 记录 集中 找到 该 窗 体 名 
formObject.Caption = rs.Fields(1) ' 指 定 窗 体 的 标题 
rs.MoveFirst "将 记录 集 指 针 归 位 


' 循 环 所 有 窗口 中 的 控件 ， 为 对 应 控件 指定 标题 
For Each i In formObject.Controls 


rs.Find "Name=" & i.Name & "" "在 记录 集中 找到 该 控件 名 
i.Caption = rs.Fields(1) "指定 控件 的 标题 
rs.MoveFirst ' 将 记录 集 指 针 归 位 

Next 

On Error GoTo 0 

rs.Close ' 关 闭 rs 记录 集 对 象 
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Set rs = Nothing 
End Sub 


12.3.4 ”刷新 工作 筹 列表 过 程 代码 设计 


刷新 工作 秒 列 表 过 程 用 于 刷新 选择 工作 禾 窗 口中 显示 选择 工作 簿 的 ListView 控件 项 目的 
过 程 。 在 选择 工作 德 窗口 第 一 次 被 加 载 或 者 再 次 被 显 
过 程 。 在 选择 工作 禾 窗 口 第 一 次 被 加 载 或 者 再 次 被 显 Re 


示 出 来 时 都 会 被 执行 一 次 ， 以 便 ListView 控件 能 正确 
反映 用 户 做 出 的 操作 。 
在 数据 库 文件 中 的 工作 秒表 中 ， 存 储 的 就 是 有 关 国 
工作 夭 选 择 的 相关 信息 资料 。 要 刷新 工作 簿 列表 ， 只 
需要 将 该 工作 簿 中 的 数据 读 取出 来 ， 然 后 根据 这 些 数 
据 进行 设置 即 可 。 
各 序 首先 从 数据 库 中 获取 了 工作 秒表 的 所 有 数据 


信息 ， 然 后 清空 了 ListView 控件 的 显示 项 目 。 当 记录 
集 没有 记录 时 ， 说 明 没有 工作 簿 被 选择 ， 直 接 退 出 过 
确认 下 一 步 按钮 可 用 状态 


程 即 可 。 当 存在 记录 时 ， 程 序 将 为 ListView 控件 添加 


新 项 目 ， 然 后 依次 根据 记录 字段 信息 确定 控件 对 应 各 
列 的 显示 数据 。 在 这 中 间 程 序 还 确定 了 【下 一 步 】 按 
钮 的 可 用 状态 。 在 程序 中 ， 如 果 没有 一 个 选择 工作 簿 
被 选中 ，【 下 一 步 】 按 钮 将 不 可 用 。 如 图 12-8 所 示 的 
是 该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 代码 解释 : 

Public Sub 刷新 工作 得 列表 () 


图 12-8 刷新 工作 夭 列 表 过 程 流程 图 


Dim strSQL As String 
"打开 到 数据 库 工 作 簿 表 的 记录 集 
rs.Open "select * from [工作 短 ]", cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic 
frm 选择 工作 簿 .List 工作 簿 .Listltems.Clear "清空 List 工作 簿 控件 项 目 
ff rs.RecordCount = 0 Then Exit Sub ' 记 录 集 为 空 时 直接 退出 过 程 
Do Until rs.EOF "循环 到 记录 集 终端 
With frm 选择 工作 簿 .List 工作 簿 .Listltems.Add(Text:=rs.Fields(" 工 作 簿 名 ")) ”“”' 添 加 项 目 
.Subltems(1) = rs.Fields(" 工 作 簿 路 径 ") ' 添 加 新 项 目的 第 一 个 子 项 目 
' 确 定 项 目 是 否 被 勾 选 
lfrs.Fields(" 是 否 选 定 ") = True Then 
.Checked = True "项 目 被 选中 
Else 
.Checked = False "项 目 不 被 选中 
End If 
lf .Checked Then frm 选择 工作 筹 .btn 下 一 步 .Enabled = True  ”' 确 定 下 一 步 按 钮 可 用 状态 
End With 
rs.MoveNext "移动 记录 集 指针 到 下 一 条 
Loop 


A453 


;办公 应 用 非 常 之 . 禾 


Excel VBA 应 用 开发 经 典 案例 


rs.Close ' 关 闭 记录 集 


Set rs = Nothing 
End Sub 


12.3.5 ”保存 选择 工作 秒 代 码 设计 


在 选择 工作 禾 窗 口中 ， 用 户 需 要 将 包含 合并 工作 表 的 所 有 工作 憩 都 一 一 显示 在 工作 短 列 
表 控 件 中 。 用 户 可 以 通过 【打开 】 按 钮 获取 对 应 工作 短文 件 的 详细 路 径 。 该 获取 方式 可 以 一 
次 获取 多 个 工作 矢 的 路 径 。 单 击 其 中 的 【打开 】 按 钮 弹出 一 个 【系统 打开 】 对 话 框 ， 用 户 选 
择 文件 后 ， 实 际 上 不 是 真正 打开 了 选择 文件 ， 而 是 程序 将 这 些 文件 的 详细 路 径 记录 下 来 ， 以 


便 程序 实现 窗口 工作 德 列表 的 刷新 操作 。 

保存 选择 工作 筹 过 程 正 是 为 保存 用 户 每 次 单 击 【 打 
开 ]】 按钮 后 的 选择 文件 详细 路 径 而 用 。 这 些 数据 将 被 保存 
到 数据 库 的 工作 秒表 工作 答 路 径 字段 中 , 同时 还 确认 了 该 
表 的 其 他 字段 的 数据 。 

过 程 的 主体 是 一 个 For 循环 。 该 循环 的 循环 变量 以 打 
开工 作 短 的 总 数量 开始 ， 步 长 为 -1， 循 环 到 1 为 止 。 循 环 
体 中 , 程序 首先 确认 打开 工作 簿 是 否 在 列表 已 经 显示 。 如 
果 已 经 显示 ， 则 进入 下 一 个 打开 工作 敌 的 检测 工作 。 

在 选择 工作 禾 窗 口中 打开 了 工作 簿 后 , 工作 簿 列表 将 
把 这 些 工 作 短 一 一 记录 。 但 是 在 进入 下 一 步 工 作 表 的 选择 
前 , 需要 在 列表 中 选中 至 少 一 个 工作 夭 。 保 存 选 择 工作 簿 
的 过 程 就 是 用 于 将 用 户 选 中 的 工作 簿 在 数据 库 中 加 以 标 
记 , 而 没有 选中 的 工作 德 则 去 掉 标记 ,以 便 选择 工作 乱 窗 
口 再 次 被 打开 时 ， 窗 口中 显示 的 是 用 户 先前 的 选择 设置 。 
程序 将 把 该 工作 敌 的 路 径 与 文件 名 保存 到 数据 库 的 工作 
适 表 中 ， 并 设置 工作 短 为 选中 状态 。 如 图 12-9 所 示 的 是 
该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 代码 解释 : 

Public Sub 保存 选择 工作 簿 () 


初始 化 循环 变量 ;为 选 
择 工作 短 数 组 维 数 


获取 工作 短路 径 等 
于 arr 选 择 工作 短 (i) 
工作 夭 记 录 集 


获取 工作 簿 表 所 
有 记录 的 记录 和 集 


添加 新 记录 并 设 
置 字段 值 
刷新 记录 集 


图 12-9 保存 选择 工作 筹 过 程 流程 图 


Dim strSQL As String 
Dim itemlist As Listltem 
On Error Resume Next "发 生 错 误 时 ， 继 续 执行 下 一 条 语句 


Fori= UBound(arr 选择 工作 往 ) To 1 Step -1 


strSQL = "select * from [工作 短 ] where 工作 短路 径 =" & arr 选择 工作 簿 (i) & "" “' 设 置 查询 字符 串 


rs.Close "关闭 rs 记录 集 
rs.Open strSQL, cnn 临时 数据 往 ' 获 取 工 作 簿 路径 为 arr 选择 工作 簿 (i) 的 工作 簿 记录 和 集 
lfrs.RecordCount > 0 Then 

GoTo Next_For ' 当 记录 集 有 记录 时 ,结束 该 次 循环 , 继续 检测 下 一 个 工作 簿 
Else 


strSQL = "select * from [工作 短 ]” ' 设 置 查 询 字符 串 
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With rs 
.Close ' 关 闭 rs 记录 集 
获取 工作 秒表 所 有 记录 的 记录 集 
.Open strSQL, cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic 
.AddNew ' 添 加 新 记录 
.Fields(" 工 作 短路 径 ") = arr 选择 工作 簿 (i) ' 设 置 工作 簿 路 径 字段 值 
.Fields(" 工 作 往 名 ") = 获取 工作 簿 名 (arr 选择 工作 和 (i)) "设置 工作 短 名 字段 值 
.Fields(" 是 否 选 定 ") = False ' 设 置 是 否 选 定 字段 值 
‘Update 更 新 工作 秒表 
End With 
End If 
Next_For: 
Next 
Set itemlist = Nothing 
rs.Close 
Set rs = Nothing 
On Error GoTo 0 
End Sub 


12.3.6 保存 选择 工作 短 过 程 代 码 设计 


保存 选择 工作 筹 过程 正 是 修改 数据 库 中 对 应 工作 筹 的“ 是否 选 定 ” 字 段 ， 以 保证 窗口 在 
重 显 时 各 个 工作 秒 的 选 定 状态 的 正确 性 。 在 选择 工作 簿 窗口 完成 了 工作 ey 还 需要 再 
次 选中 需要 备份 工作 表 的 工作 夭 ， 否 则 窗口 中 的 【下 一 步 】 按 钮 是 不 会 被 激活 的 

设置 选中 工作 短 “ 是 否 选 定 ” 字 段 ， 可 以 选择 两 个 方法 ;一 个 是 选择 i 工作 竹 
列表 中 项 目 被 单 击 时 ， 检 测 项 目的 选 定 状态 ， 进 而 修改 数据 库 数据 ; | 【 下 一 步 】 


按钮 时 ， 将 选择 工作 簿 窗口 工作 短 列 表 中 所 有 项 目的 选 定 状态 写 入 到 数据 库 中 。 选 择 工作 敌 
窗口 采用 了 第 二 种 方法 ， 而 在 后 面 的 选择 工作 表 窗 口中 采用 了 第 二 种 方法 。 读 者 可 以 比较 两 
种 方法 的 实现 方式 。 


第 一 种 方法 不 断 地 在 数据 库 中 打开 记录 集 并 频繁 修改 数据 ， 如 果 对 于 数据 修改 的 时 效 性 
要 求 较 强 ， 应 该 采用 该 方法 。 而 第 二 种 方法 只 打开 数据 库 一 次 并 且 一 次 性 完成 修改 操作 ， 从 
系统 运行 速度 方面 考虑 应 该 尽量 采用 第 二 种 方法 。 

以 下 是 该 过 程 的 代码 解释 : 

Public Sub 保存 选中 工作 筹 () 

Dim itemlist As Listltem 

打开 到 数据 库 工作 秒表 的 记录 集 

rs.Open "select * from [工作 敌 ]", cnn 临时 数据 簿 , adOpenDynamic, adLockOptimistic 

' 逐 个 检测 工作 簿 列表 中 项 目的 选 定 状态 ， 并 修改 工作 簿 表 中 “是 否 选 定 ” 字 段 的 数据 

For Each itemlist In frm 选择 工作 筹 .List 工作 簿 .Listltems 


If itemlist.Checked Then 

rs.Fields(" 是 否 选 定 ") = True ' 项 目 为 选 定时 ， 修 改 “ 是 否 选 定 ” 项 为 真 
Else 

rs.Fields(" 是 否 选 定 ") = False 项 目 为 未 选 定时 ， 修 改 “ 是 否 选 定 ”项 为 假 
End 上 
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rs.Update ' 更 新 记录 集 
rs.MoveNext "将 记录 集 移动 到 下 一 条 
Next 
rs.Close ' 关 闭 记 录 集 
Set rs = Nothing 
End Sub 


12.3.7 ”合并 工作 簿 过 程 代码 设计 


合并 工作 禾 是 合并 备份 工作 铸模 块 的 核心 程序 。 该 程序 根据 用 户 设 置 的 保存 文件 路 径 与 
名 称 、 工 作 筹 中 包含 的 工作 表 ， 完 成 合并 备份 工作 。 该 过 程 代码 很 长 ， 这 里 将 分 段 介绍 该 过 
程 合 并 工作 禾 功 能 的 实现 过 程 。 

程序 首先 根据 用 户 设置 的 文件 保存 信息 ， 检 测 该 位 置 是 否 已 经 存在 此 文件 。 当 存在 时 
用 户 可 以 设置 覆盖 和 添加 。 覆 盖 将 删除 原文 件 ， 添 加 将 打开 该 文件 并 把 表 添 加 到 该 工作 簿 中 。 
不 存在 时 ， 则 可 以 直接 添加 新 工作 簿 。 对 于 新 添加 的 工作 簿 ， 首 先 需 要 清除 默认 建立 的 工作 
表 。 但 是 工作 秒 中 至 少 需要 有 一 个 工作 表 ， 因 此 有 一 个 表 需 要 在 最 后 完成 所 有 的 表 复 制 操 作 
后 才 可 以 删除 。 该 表 的 名 称 被 保存 在 变量 DeleteID 中 。 

删除 新 工作 短 中 的 默认 表 后 ， 程 序 将 从 数据 库 中 获取 需要 合并 的 数据 表 。 程 序 打开 记录 
集 时 ， 按 照 工作 短路 径 进行 了 分 组 。 程 序 根据 分 组 依次 打开 需 备 份 工作 表 的 工作 短 ， 从 记录 
集中 得 到 需 备份 的 工作 表 名 。 当 该 工作 表 名 与 DeleteID 相同 时 ， 需 要 对 DeleteID 对 应 表 的 表 
名 进行 修改 ， 否 则 复制 工作 表 工 作 将 无 法 正确 完成 。 

将 打开 工作 簿 需要 复制 的 表 都 复制 到 结果 工作 簿 中 后 ， 程 序 将 保存 该 工作 敌后 关闭 该 工 
作 每 ， 然 后 打开 下 一 个 需要 复制 工作 表 的 工作 短 ， 继 续 复制 工作 表 。 将 所 有 工作 表 复 制 完 成 
后 ， 程 序 保存 该 结果 工作 筹 ， 然 后 显示 提示 保存 结束 信息 并 结束 过 程 。 

由 于 该 过 程 的 流程 比较 复杂 , 为 了 让 读者 能 更 准确 了 解 过 程 的 流程 , 这 里 将 把 整个 过 程 
分 成 两 个 流程 图 。 第 一 个 流程 图 中 最 后 实现 将 工作 表 保 存 到 工作 德 的 过 程 没 有 列 出 明细 。 第 二 
个 流程 图 展示 的 是 将 工作 表 保 存 到 工作 敌 的 流程 。 这 两 个 流程 图 如 图 12-10 和 图 12-11 所 示 。 


将 所 有 工作 表 复制 到 工作 矢 中 


图 12-10 合并 工作 矢 过 程 流程 图 


打开 按 工 作 短路 径 排序 的 工作 表 记 录 集 
获取 记录 集 首 条 记录 
到 记录 集 末 端 ? 


一 一 上 一 次 打开 工作 等 名 称 sttPreWB 是 否 为 空 7 一 一 


打开 当前 记录 中 的 工作 等 


一 sfrPreWB 是 否 与 记录 集 工作 短路 径 不 一 致 一 一 


关闭 原 开启 工作 短 
获取 需要 复制 的 工作 表 对 象 
工作 表 名 是 否 与 需 删 除 表 重 名 ? 
记录 删除 表 当 前 名 称 
移 到 下 一 条 记录 
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图 12-11 将 需 复制 的 所 有 工作 表 复 制 到 工作 短 中 流程 


Public Sub CombineWorkBook(FileLoc As String) 
Dim wk As Workbook, ws As Worksheet 


Dim ResultFileLoc As String, resultWK As Workbook, DeletelD As String 
Dim strTemp As String, intPos As Integer, strPreWB As String 


Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
获取 工作 簿 名 称 ， 包 括 后 缀 名 


ResultFileLoc = FileLoc 
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strTemp = StrReverse(FileLoc) 
intPos = InStr(1, strTemp, Application.PathSeparator) 
strTemp = StrReverse(Left(strTemp, intPos -1)) 
"检测 保 存 工作 往 位 置 是 否 已 经 存在 该 文件 ， 当 存在 时 ， 提 示 是 否 覆 盖 
' 用 户 可 以 选择 添加 ， 将 所 有 表 添 加 进 该 工作 簿 中 
"1 一 表示 覆盖 文件 ，2 一 添加 文件 ，3 一 取消 操作 
If Dir(ResultFileLoc) = strTemp Then 
"文件 存在 时 执行 以 下 代码 
Dim frmTemp As New frm 提示 信息 


frmTemp.ShowFormTiplnflanguageset "显示 提示 信息 窗口 
Select Case BtnClicklndex 
Casels=1 
Kill ResultFileLoc "删除 对 应 位 置 中 的 文件 
Set resultWK = Workbooks.Add "添加 工作 簿 
With resultWK 
.SaveAs FileLoc "保存 工作 簿 
Do Until .Sheets.Count = 1 ' 删 除 新 添 工作 秒 中 的 表 ， 直 到 只 有 一 个 表 
.Sheets(1).Delete ' 删 除 sheet(1) 
Loop 
DeletelD = .Sheets(1).Name "记录 最 后 一 个 表 的 名 称 
End With 
Casels=2 
Set resultWK = Workbooks.Open(ResultFileLoc) 和 打开 工作 简 
Casels=3 
GoTo Exit_Sub "终止 过 程 
Case Else 
GoTo Exit_Sub 终止 过 程 
End Select 
Else 
"文件 不 存在 时 ， 执 行 以 下 代码 
Set resultWK = Workbooks.Add "新 添 工作 簿 
With resultWK 
.SaveAs FileLoc "保存 新 工作 簿 
Do Until .Sheets.Count = 1 "删除 新 工作 短 中 的 表 直 到 只 有 一 个 表 
.Sheets(1).Delete "删除 表 
Loop 
DeletelD = .Sheets(1).Name "保存 最 后 一 个 表 的 名 称 
End With 
End If 
On Error Resume Next 
rs.Close ' 关 闭 记录 集 


On Error GoTo 0 


rs.Open "select * from 工作 表 order by 工作 短路 径 ", cnn 临时 数据 往 。 “”' 按 工作 筹 路 径 字 段 打 开工 作 
表 记 录 集 
If rs.RecordCount Then 
rs.MoveFirst "记录 集 移动 到 第 一 条 记录 
Do Until rs.EOF "循环 直到 最 后 一 条 记录 
If strPreWB = "" Then ' 检 测 前 一 个 打开 工作 簿 的 路 径 
Set wk = Workbooks.Open(rs.Fields(" 工 作 短路 径 ")) 打开 工作 簿 
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strPreWB = wk.FullName "定义 strPreWB 字符 串 
End lf 
'strPreWB 与 当前 工作 短路 径 不 一 致 时 ， 需 要 打开 该 工作 簿 
If strPreWB <> rs.Fields(" 工 作 簿 路 径 ") And strPreWB <> " Then 


wk.Close 
Set wk = Workbooks.Open(rs.Fields(" 工 作 短路 径 ")) ” ' 打 开 对 应 工作 筹 路 径 的 工作 簿 
strPreWB = wk.FullName 保存 工作 簿 路径 到 strPreWB 

End If 

' 定 义 需要 复制 的 工作 表 

Set ws = wk.Sheets(Left(rs.Fields(" 工 作 表 名 "), Len(rs.Fields(" 工 作 表 名 ")) -1)) 

If ws.Name = DeletelD Then "检测 工作 表 是 否 与 DeletelD 相同 
resultWK.Sheets(DeletelD).Name = DeletelD + "0"” ” ' 修 改 DeletelD 表 的 名 称 
DeletelD = DeletelD + "0" 路 改 DeletelD 

End If 

ws.Copy before:=resultWK.Sheets(1) "复制 工作 表 

rs.MoveNext ' 移 动 记录 集 指 针 到 下 一 条 

Loop 

wk.Close 关闭 工作 簿 
resultWK.Sheets(DeletelD).Delete ' 删 除 Delete 表 
Application.DisplayAlerts = True "显示 警告 消息 
resultWK.Save ' 保 存 工作 簿 


"根据 语言 设置 ， 显 示 对 应 备份 完成 信息 
lflanguageset Then 
MsgBox "BackFile Process accomplished!", vbOKOnly + vblnformation 
Else 
MsgBox "备份 文件 完成 ", vbOKOnly + vblnformation 
End If 
Else 
' 根 据 语言 设置 ， 显 示 没有 任何 表 选 中 信息 
Iflanguageset Then 
MsgBox "There is no sheet selected!", vbOKOnly + vbExclamation 
Else 
MsgBox "没有 任何 表 被 选中 ", vbOKOnly + vbExclamation 
End If 
End If 
Exit_Sub: 
Application.ScreenUpdating = True 
Set ws = Nothing 
Set wk = Nothing 
Set rs = Nothing 
End Sub 


12.3.8 ”链接 字符 串 与 工作 得 名 获取 过 程 代 码 设计 


返 


链接 字符 串 与 工作 筹 名 获取 过 程 是 两 个 自 定义 函数 。 两 个 函数 都 接受 一 个 字符 串 参 数 并 


口 


一 个 字符 串 作 为 该 函数 的 结果 。 这 两 个 函数 的 功能 及 运行 方式 描述 如 下 : 
口 获取 工作 簿 名 函数 接受 工作 秒 的 完整 路 径 ， 注 意 该 参数 是 按 值 传递 的 。 首 先 程 序 
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将 该 参数 字符 串 反 向 ， 再 从 反 向 字符 串 中 获取 “\” 符 号 第 一 次 出 现 的 位 置 。 然 后 
程序 从 反 向 字符 串 左 边 第 一 个 字符 开始 ， 取 到 “\” 出 现 位 置 的 所 有 字符 。 该 获取 的 
字符 串 即 为 工作 秒 名 的 反 向 字符 串 。 将 该 获取 得 到 的 字符 串 反 向 后 即 为 该 函数 的 返 
可 值 。 
口 “ 获 取 链 接 字符 串 : 函数 接受 一 个 Excel 或 Access 文件 的 完整 路 径 ， 然 后 函数 返回 链 
接 到 该 文件 的 链接 字符 串 。 该 函数 可 以 接受 Excel 2007 或 Access 2007 文件 作为 数据 
库 文件 。 

以 下 是 两 个 函数 的 详细 代码 解释 : 

Public Function 获取 工作 簿 名 (ByVal strWKPath As String) As String 

Dim strTemp As String, i As Integer 


strTemp = StrReverse(strWKPath) ' 反 向 工作 短文 件 路 径 

i= InStr(1, strTemp, "\") ' 获 取 反 向 工作 短文 件 路 径 中 第 一 个 “\” 符 号 出 现 的 位 置 
strTemp = Left(strTemp, i -1) ' 获 取 工 作 簿 名 的 反 向 字符 串 

获取 工作 筹 名 = StrReverse(strTemp) ' 获 取 工 作 往 名 

End Function 


Public Function GetConnString(strFilePath As String) As String 
' 系 统 中 只 使 用 了 两 个 文件 作为 数据 库 文件 。 一 个 是 该 加 载 宏 文件 ， 一 个 是 Access 2007 数据 库 文件 
' 所 以 这 里 的 代码 十 分 简单 。 只 对 文件 后 组 稍 加 判断 就 确认 了 相应 的 链接 字符 串 格式 
If LCase(Right(strFilePath, 5)) = "accdb" Then 

文件 为 Access2007 文件 时 的 链接 字符 串 

GetConnString = "Provider=microsoft.ace.oledb.12.0;data source=" & strFilePath 
Else 

"文件 为 本 Excel 2007 加 载 宏 文件 时 的 链接 字符 串 

GetConnString = "Provider=microsoft.ace.oledb.12.0;extended properties=Excel 12.0;data 
Source="”_ 

& strFilePath 

End 上 
End Function 


12.4 ” 拆 分 工作 簿 窗 体 设计 


拆 分 工作 夭 窗 体 可 以 完成 各 项 拆 分 设置 ， 用 户 单 击 【 开 始 拆 分 】 按 钮 后 ， 程 序 将 利用 这 
些 设置 完成 拆 分 工作 。 设 置 工 作 包括 拆 分 工作 表 位 置 设 置 、 工 作 表 分 组 组 别 设置 、 工 作 表 分 
配 设 置 ， 这 些 设 置 在 窗 体 中 都 可 以 逐 项 被 实现 。 

该 窗 体 拆 分 时 ， 只 能 对 一 个 工作 簿 的 工作 表 进 行 拆 分 。 拆 分 出 来 的 工作 敌 可 以 包含 原 工 
作 敌 的 多 个 工作 表 。 


12.4.1 窗 体 界面 设计 


窗 体 界面 分 为 3 大 块 。 第 一 块 是 设置 拆 分 工作 乱 的 路 径 ， 第 二 块 显示 所 有 未 分 配 工 作 表 


Ah 
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列表 ， 第 三 块 用 于 设置 分 组 组 别 以 及 工作 表 的 组 别 分 配 设置 。 表 12-5 列 出 了 该 窗 体 中 所 有 控 
件 的 控件 名 、 控 件 类 型 及 控件 说 明 。 如 图 12-12 所 示 为 该 窗 体 的 界面 。 


控 件 名 


控件 类 型 


表 12-5” 拆 分 工作 簿 窗口 控件 列表 
控件 说 明 


Frame 拆 分 工作 短 


框架 


该 控件 用 于 包含 设 定 需 要 拆 分 的 工作 矢 的 控件 


txt 拆 分 工作 秒 。 ”| 文 本 柜 ”| 该 文本 框 用 于 显示 需要 拆 分 的 工作 壬 的 位 潮 
i 有 间 击 该 毛 包 后 打开 文件 路 笃 区 了 窗口。 在 窗口 中 选择 了 文人 后 , 该 文 人 的 
路 径 将 被 显示 在 拆 分 工作 短文 本 框 中 

Frame 未 分 配 工作 表 | 框架 该 控件 用 于 包含 未 分 配 工 作 表 列表 的 控件 
List 未 分 配 表 ListView 该 控件 显示 所 有 没有 未 分 配 的 工作 表 
ee 人 单 击 该 按钮 后 , 未 分 配 表 中 被 选中 的 表 将 被 分 配 到 右 侧 的 列表 中 。 所 处 的 
分 类 即 为 当前 分 组 
Frame 已 分 配 工 作 表 | 框架 该 框架 包含 组 别 设 管 杠 ， 以 及 该 组 别 中 的 工作 表 列 表 
”| 该 控件 中 显示 了 所 有 的 工作 表 分 组 类 别 。 单 击 【 开 始 拆 分 】 按 饥 后 ， 拆 分 

Sb 复合 框 。。 | 出 来 的 新 工作 等 将 使 用 该 类 别 建立 
btn 添加 类 别 按 人 该 按钮 用 于 将 组 别 复合 框 中 的 新 类 别 添加 到 数据 库 中 , 并 刷新 组 别 复合 杠 
btn 删除 按 负 单 击 该 按钮 后 ， 程 序 将 把 该 分 组 下 选中 的 工作 表 重 新 分 配 到 未 分 配 表 中 

晴 单 击 该 按钮 后 ,程序 将 开始 执行 拆 分 工作 。 在 此 之 前 ， 需 要 保证 没有 表示 
btn 开始 拆 分 按钮 


ED 
一 训 览 拆 分 工作 牧 : 


被 分 配 


sm | mm | 


WE 


制作 该 窗 体 的 步骤 如 下 : 

(1) 在 Excel2007 的 VBE 开发 环境 中 依次 选择 【插入 】|【 用 户 窗 体 】 命 令 ， 在 属性 窗 
口中 设置 名 称 属性 为 “frm 拆 分 工作 短 ”， 如 图 12-13 所 示 。 

(2) 在 工具 箱 中 选择 框架 控件 。 在 窗 体 中 单 击 鼠标 左 键 并 拖 动 以 产生 适当 大 小 的 框架 ， 
随后 复制 该 框架 2 份 。 在 属性 窗口 中 依次 设置 各 个 框架 控件 的 Caption 属性 为 “浏览 拆 分 工作 


» 


竹 : 、 


图 12-12 拆 分 工作 敌 窗 体 界面 


“未 分 配 工作 表 : ”和 “已 分 配 工作 表 : ”。 名 称 属性 依次 设置 为 “Frame 拆 分 工作 


短 ”、“Frame 未 分 配 工作 表 ” 和 “Frame 已 分 配 工作 表 ”。 窗 体 的 实际 设计 效果 如 图 12-14 


所 示 。 


办 公 应 用 非 党 之 稍 


Excel VBA 应 用 开发 经 典 案例 


可 
re 拆 分 工作 小 UserForn 了 


图 12-13 ” 拆 分 工作 筹 窗口 属 性 设计 图 12-14 ” 拆 分 工作 矢 窗 体 设计 效果 图 


(3) 在 工具 箱 中 选择 文本 框 控件 。 在 “浏览 拆 分 工作 短 ” 框 架 左 侧 插入 一 文本 框 。 在 属 
性 窗口 中 修改 名 称 属 性 为 “txt 拆 分 工作 短 ”，SelectionMargin 属性 为 False， 如 图 12-15 所 示 。 

(4) 在 工具 箱 中 选择 按钮 控件 。 在 “浏览 拆 分 工作 短 ” 框 架 右 侧 插入 一 个 按钮 。 在 “未 
分 配 工作 表 ” 框 架 底 部 、“ 已 分 配 工作 表 ” 框 架 右上 侧 及 底部 和 窗 体 的 底部 各 再 插入 一 个 按 
钮 。 然 户 在 属性 窗口 中 依次 设置 各 个 按钮 的 Caption 属性 为 “浏览 ”、“ 添 加 ”、“ 添 加 ”、 
“删除 ”和 “开始 拆 分 ”， 并 设置 各 个 按钮 的 名 称 为 “btn 浏览 ”、“btn 添加 ”、“btn 添加 
类 别 ”、“btn 删除 ”和 “btn 开始 拆 分 ”。 

(5) 在 工具 箱 中 选择 复合 框 控件 。 在 “已 分 配 工作 表 ” 框 架 左 上 侧 插入 一 复合 框 ， 
二 同村 宁 且 中 没 轩 六 2 全民 肌 各 区 属相 为 “comb 组 别 ”， 如 图 12-16 所 示 。 

£| 
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图 12-15 设置 文本 框 的 SelectionMargin 属性 图 12-16 复合 框 属性 设计 


(6) 在 工具 箱 中 选择 ListView 控件 。 在 “未 分 配 工作 表 ” 框 架 和 “已 分 配 工作 表 ” 框 架 
中 各 插入 一 个 ListView 控件 ， 随 后 在 属性 窗口 中 依次 设置 两 控件 的 名 称 属 性 为 “List 未 分 配 
表 ” 和 “List 已 分 配 表 ”。 


12.4.2 ”变量 定义 与 窗口 激活 事件 代码 设计 


窗口 中 定义 了 一 个 变量 str。 该 变量 存储 需 拆 分 工作 短文 件 的 后 缀 ， 拆 分 后 的 工作 短 将 被 
保存 为 该 后 级 的 工作 短文 件 。 因 为 Excel 2007 与 之 前 版 本 的 Excel 文件 的 后 绥 不 一 样 ， 根 据 该 
后 绥 名 可 以 确定 保存 的 文件 类 型 和 原文 件 类 型 一 致 。 


Ah 
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窗口 初始 化 时 ， 需 要 清除 数据 库 中 存储 的 有 关 拆 分 工作 敌 的 记录 信息 。 在 数据 库 中 拆 分 
表 与 拆 分 表 组 别 两 个 表 的 记录 都 需要 清除 。 程 序 通 过 ADO 数据 库 链接 的 Execute 方法 执行 删 
除 命令 操作 ， 然 后 通过 刷新 List 控件 实现 对 ListView 控件 显示 效果 的 重 置 。 该 过 程 的 代码 请 
见 后 续 小 节 介 绍 。 

Dim str 后 缀 As String 


Private Sub UserForm_Activate() 

cnn 临时 数据 簿 .Execute "delete * from 拆 分 表 " 

cnn 临时 数据 篇 .Execute "delete * from 拆 分 表 组 别 " 
刷新 List 控件 

End Sub 


12.4.3 ”刷新 List 控件 过 程 代码 设计 
刷新 List 控件 过 程 用 于 设置 窗口 中 两 个 ListView 控件 的 显示 效果 以 及 标题 行 。 该 过 程 代 


码 比较 简单 ， 以 下 是 该 过 程 的 代码 解释 。 
Private Sub 刷新 List 控件 () 


"设置 List 未 分 配 表 控 件 
With List 未 分 配 表 
.Gridlines = True ' 显 示 网 格 线 
.FullRowSelect = True ' 允 许 整 行 选择 
.MultiSelect = True ' 允 许多 行 选择 
.LabelEdit = |vwManual ' 单 击 项 目 时 ， 不 进入 编辑 状态 
.View = lvwReport "设置 显示 模式 
.CheckBoxes = True ' 是 否 显示 项 目 选择 框 
With .ColumnHeaders 
.Clear ' 清 除 控件 标题 
Iflanguageset Then 
.Add Text:="SheetName", Width:=125 "英文 标题 显示 
Else 
.Add Text:=" 工 作 表 名 ", Width:=125 "中 文 标题 显示 
End If 
End With 
End With 
' 设 置 List 已 分 配 表 控 件 
With List 已 分 配 表 
.Gridlines = True "显示 网 格 线 
.FullRowSelect = True "允许 整 行 选择 
.MultiSelect = True ' 允 许多 行 选择 
.LabelEdit = lvwManual ' 单 击 项 目 时 ， 不 进入 编辑 状态 
.View = lvwReport "设置 显示 模式 


.CheckBoxes = True 

With .ColumnHeaders 
.Clear "清除 控件 标题 
lflanguageset Then 


办 公 应 用 旨 党 乞 煞 - 


Excel VBA 应 用 开发 经 典 案例 


.Add Text:="SheetName", Width:=125 ' 英 文 标题 显示 
Else 
.Add Text:=" 工 作 表 名 ", Width:=125 "中 文 标题 显示 
End If 
End With 
End With 
End Sub 


12.4.4， 拆 分 工作 篇 文本 框 与 浏览 按钮 代码 设计 


拆 分 工作 短文 本 框 和 浏览 按钮 共同 完成 设置 拆 分 工作 筹 位 置 的 工作 。 浏 览 按 钮 用 于 获取 
需 拆 分 的 工作 短 的 路 径 ， 并 将 该 路 径 显示 在 拆 分 工作 短文 本 框 中 。 当 拆 分 工作 短文 本 框 中 数 
据 发 生变 化 时 ， 将 激发 拆 分 文本 框 改变 事件 。 

该 事件 过 程 首先 清除 了 原来 存储 在 数据 库 中 的 信息 ， 以 便 存 储 新 工作 短 的 信息 资料 。 接 
着 程序 检测 新 指定 文件 路 径 下 是 否 有 该 文件 存在 ， 当 存在 时 ， 程 序 首先 获取 该 工作 敌 所 有 工 
作 表 的 名 称 。 然 后 将 工作 表 显 示 到 List 未 分 配 表 控 件 中 ， 并 将 这 些 表 名 写 入 数据 库 中 。 新 写 
入 数据 库 的 表 名 标记 为 “未 分 配 ”。 图 12-17 是 该 过 程 的 流程 图 。 


删除 数据 库 拆 分 表 
与 拆 分 表 组 别 数据 


将 工作 表 名 显示 在 未 
分 配 表 列 表 控件 中 
在 数据 库 中 添 
加 新 记录 


下 一 个 工作 表 


图 12-17” 拆 分 工作 短文 本 框 改 变 事件 过 程 的 流程 图 
以 下 是 该 事件 的 代码 解释 : 
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Private Sub txt 拆 分 工作 筹 _Change() 


Dim strTemp As String 
Dim catalog As New ADOX.catalog, table As New ADOX.table 
cnn 临时 数据 簿 .Execute "delete * from 拆 分 表 " "删除 拆 分 表 所 有 记录 
cnn 临时 数据 短 .Execute "delete * from 拆 分 表 组 别 " "删除 拆 分 表 组 别 所 有 记录 
strTemp = Dir(txt 拆 分 工作 短 .Text) ' 查 找 拆 分 工作 简 
On Error Resume Next 
rs.Close 
On Error GoTo 0 
If strTemp <> " Then "检测 拆 分 工作 簿 是 否 存 在 
catalog.ActiveConnection = GetConnString(txt 拆 分 工作 簿 .Text) 获取 拆 分 工作 簿 对 应 的 
catalog 对 象 
rs.Open "select* from 拆 分 表 ", cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic “打开 记录 集 
List 未 分 配 表 .Listltems.Clear ' 清 除 未 分 配 表 列 表 中 所 有 项 目 
For Each table In catalog. Tables "循环 Catalog 对 象 中 所 有 表 对 象 
List 未 分 配 表 .Listltems.Add Text:=Left(table.Name, Len(table.Name) -1) "添加 新 项 目 
With rs 
rs.AddNew 为 记录 集 增加 新 记录 
rs.Fields(" 工 作 表 名 ") = table.Name "设置 工作 表 名 字段 
rs.Fields(" 组 名 ") = "未 分 配 " "设置 组 名 字段 
rs.Update "更 新 拆 分 表 
End With 
Next 
End If 
End Sub 


Private Sub btn 浏览 _Click() 
获取 拆 分 工作 往 的 完全 路 径 
str 拆 分 工作 簿 = Application.GetOpenFilename("Excel2000-2007 file(*.xls;*.xlsx),*.xls;*.xlsx", 


MultiSelect:=False) 
txt 拆 分 工作 筹 .Text = str 拆 分 工作 簿 "将 选择 路 径 显示 到 拆 分 工作 短文 本 框 中 


End Sub 
12.4.5 ”添加 按钮 单 击 事件 代码 设计 


未 分 配 工作 表 框 架 中 的 【添加 】 按 钮 在 被 单 击 时 ， 将 把 未 分 配 工作 表 列表 中 所 有 选中 的 
工作 表 转 移 到 右 侧 分 组 中 。 

过 程 首先 检测 右 侧 的 组 别 是 否 有 选择 项 。 当 没有 选择 项 时 ， 提 示 没 选择 分 类 后 直接 退出 
过 程 。 当 有 分 组 时 ， 程 序 逐 个 检测 未 分 配 工作 表 中 的 项 目 ， 当 项 目 被 选中 时 ， 在 已 分 配 表 列 
表 中 添加 该 项 目 ， 然 后 将 该 项 目 在 数据 库 中 的 组 名 标示 为 该 组 别 ， 最 后 程序 把 未 分 配 工作 表 
列表 中 选中 项 目 移 除 后 退出 过 程 。 该 过 程 的 流程 图 如 图 12-18 所 示 。 

限于 篇 幅 ， 流 程 图 中 关于 删除 未 分 配 表 列表 中 选中 项 目 过 程 没 有 列 出 具体 的 操作 流程 。 
下 面 将 介绍 该 过 程 流程 。 该 过 程 是 一 个 Do…Loop 循环 ， 其 循环 变量 是 项 目的 索引 号 。 


图 12-18 


获取 未 分 配 表 列表 
第 一 个 项 目 对 象 


将 项 目 添加 到 已 
分 配 列表 中 


修改 数据 库 中 工作 表 名 为 项 
目 工作 表 的 记录 的 组 别 字 符 


移动 到 下 一 项 目 


删除 未 分 配 表 中 
选中 的 项 目 


退出 


【添加 】 按 钮 单 击 事件 流程 图 


循环 开始 时 ， 程 序 从 分 配 表 列 表 第 一 个 项 目 开 始 。 如 果 该 项 目 未 被 选中 ， 则 跳 到 下 一 个 


以 下 是 该 过 程 的 代码 解释 : 
Private Sub btn 添加 _Click() 


项 目 ， 循 环 变量 将 自动 加 1， 以 将 项 目 指向 下 一 条 。 如 果 项 目 被 选中 ， 
是 循环 变量 不 用 加 1。 因 为 再 次 回 到 循环 开始 时 ， 未 分 配 表 中 项 目 数量 已 经 发 生 了 改变 ， 而 已 
删除 项 目的 下 一 条 项 目 〈 即 当前 检测 项 目 ) 的 索引 号 等 于 删除 项 目的 索引 号 。 因 而 这 种 情况 
下 检测 的 项 目 索引 号 不 需要 修改 。 当 最 后 索引 号 大 于 列表 项 目 数 时 说 明 已 经 检测 完毕 ， 即 可 
退出 循环 。 


Dim itemlist As Listltem, strSQL As String 


If comb 组 别 .Text = " Then 
MsgBox "没有 选择 分 类 ! " 
Exit Sub 

End If 


For Each itemlist In List 未 分 配 表 .Listltems 


lfitemlistChecked Then 


List 已 分 配 表 .Listltems.Add Text:=itemlist.Text 


但 序 将 删除 该 项 目 ， 但 


' 检 测 组 别 复合 框 是 否 为 空 
' 提 示 没有 选择 组 别 分 类 


' 退 出 过 程 


"循环 未 分 配 表 列表 中 所 有 项 目 


"检测 项 目 是 否 被 选中 


"将 选中 项 目 添加 到 已 分 配 表 列表 中 


' 设 定数 据 库 查询 字符 串 ， 查 询 祖 名 为 未 分 配 ， 工 作 表 名 为 项 目 值 的 记录 
strSQL = "select* from 拆 分 表 where 组 名 =' 未 分 配 ' and 工作 表 名 =" & itemlist.Text & "$" 


On Error Resume Next 


rs.Close 
On Error GoTo 0 
With rs 


<ag 
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.Open strSQL, cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic 和 打开 记录 集 


.MoveFirst "移动 到 记录 集 首 条 记录 
.Fields(" 工 作 表 名 ") = itemlist.Text & "$" ' 设 定 工作 表 名 字段 
.Fields(" 组 名 ") = comb 组 别 .Text " 设 定 组 名 字段 
.Update "更 新 记录 集 
End With 
rs.Close "关闭 记录 集 
End 上 
Next 
全 "初始 化 检测 项 目 索引 号 
Do Until i > List 未 分 配 表 .Listltems.Count "循环 直到 索引 号 超过 项 目 总 数 
If List 未 分 配 表 .Listltems(i).Checked Then "检测 未 分 配 表 第 i1 项 是 否 被 选中 
List 未 分 配 表 .Listltems.Remove 1 "将 第 i 项 删除 
Else 
i=i+1 "计算 下 一 个 检测 项 目的 索引 号 
End 上 f 
Loop 
End Sub 


12.4.6 ”组 别 复合 框 改变 事件 代码 设计 


获取 组 名 为 新 选 定 组 别 
的 工作 表 名 字段 记录 集 


组 合 复合 框 允许 用 户 选择 不 同 的 组 别 分 类 。 当 组 
别 分 类 发 生 改变 时 ， 需 要 将 新 组 别 下 所 有 已 分 配 工作 
表 显 示 在 列表 中 。 复 合 框 改 变 事件 完成 的 工作 即 为 该 
任务 。 

程序 首先 从 数据 库 拆 分 表 中 获取 组 名 为 新 选 定 
组 别 的 工作 表 名 字段 记录 集 ， 接 着 清除 已 分 配 表 列 表 
的 所 有 项 目 ， 以 便于 重新 添加 新 项 目下 被 分 配 的 表 。 
然后 程序 循环 记录 集中 所 有 记录 ， 将 工作 表 名 字段 作 
为 已 分 配 表 列表 新 项 目 添加 进去 。 该 过 程 的 流程 图 如 
图 12-19 所 示 。 

该 过 程 的 代码 解释 如 下 : 图 12-19 组 别 复合 框 改变 事件 流程 图 

Private Sub comb 组 别 _Change() 

Dim strSQL As String, strTemp As String 

On Error Resume Next 

rs.Close 

获取 组 名 为 新 选 定 组 别 的 工作 表 名 字段 记录 集 

strSQL = "select 工作 表 名 from 拆 分 表 where 组 名 =" & comb 组 别 .Text & "" " 设 定 查询 字符 串 


清空 已 分 配 表 列 表 
中 所 有 项 目 


移动 到 下 一 条 记录 


rs.Open strSQL, cnn 临时 数据 簿 , adOpenKeyset, adLockOptimistic ' 获 取 记 录 集 
List 已 分 配 表 .Listltems.Clear ' 清 除 列表 项 目 
Ifrs.RecordCount Then 
Do Until rs.EOF 到 达 记 录 集 末端 时 ， 终 止 循环 
strTemp = rs.Fields(" 工 作 表 名 ") 获取 工作 表 名 字段 
strTemp = Left(strTemp, Len(strTemp) -1) ' 去 掉 工作 表 名 最 后 的 $ 符 号 
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List 已 分 配 表 .Listltems.Add Text:=strTemp 
rs.MoveNext 
Loop 
End If 
On Error GoTo 0 
End Sub 


12.4.7 ”添加 按钮 单 击 事件 


【添加 】 按 钮 用 于 将 在 组 别 复合 框 新 输入 的 组 别 添加 到 数据 库 中 。 程 序 首先 检测 该 
在 数据 库 中 是 否 已 经 存在 。 当 已 经 存在 时 ， 直 接 退 出 过 程 即 可 。 当 检测 完 所 有 记录 完 仍然 没 
有 找到 该 组 别 时 ， 程 序 将 该 组 别 添加 进 数 据 库 中 。 图 12-20 所 示 的 是 该 过 程 的 流程 图 。 


为 已 分 配 表 添加 新 项 目 


"移动 到 下 一 条 记录 


复合 框 一 至 一 ~ 


图 12-20 添加 类 别 过 程 流程 图 


以 下 是 该 过 程 的 代码 解释 : 
Private Sub btn 添加 类 别 _Click() 
On Error Resume Next 


rs.Close ' 关 闭 记录 集 
On Error GoTo 0 
打开 到 拆 分 表 组 别 的 记录 集 
rs.Open "select * from 拆 分 表 组 别 ", cnn 临时 数据 短 , adOpenKeyset, adLockOptimistic 
If rs.RecordCount Then 
Do Until rs.EOF "循环 到 记录 集 最 末端 
ff comb 组 别 .Text = rs.Fields(" 组 名 ") Then "检测 组 别 是 否 在 记录 中 已 经 存在 
MsgBox "该 组 别 已 经 存在 !", vblnformation + vbOKOnly, "组 别 已 经 存在 " “' 提 示 存 在 
Exit Sub 
End If 
rs.MoveNext "移动 到 下 一 条 记录 


Loop 


-/ 
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End If 

With rs 
.AddNew "添加 新 记录 
.Fields(" 组 名 ") = comb 组 别 .Text "设置 新 记录 的 组 别 字 段 
.Update 更 新 拆 分 表 组 别 数 据 

End With 

comb 组 别 .Addltem comb 组 别 .Text ' 在 组 别 复合 框 中 添加 该 新 组 别 

comb 组 别 .Value = comb 组 别 .Text "设置 组 别 复合 框 的 显示 值 

MsgBox "分 配 类 别 添加 成 功 ! " "提示 添加 成 功 

rs.Close "关闭 记录 集 

End Sub 


12.4.8 ”删除 按钮 单 击 事件 代码 设计 


删除 操作 是 未 分 配 工作 表 框 架 中 【添加 】 按 钮 的 一 个 反 向 操作 。 该 按钮 将 把 已 分 配 工作 
表 列 表 中 所 有 选中 项 目 移动 到 未 分 配 工 作 表 列表 中 ， 并 且 修 改 数据 库 中 这 些 项 目 对 应 工作 表 
的 组 别 为 “未 分 配 ”。 

旦 序 首先 逐个 检测 已 分 配 表 列 表 中 的 项 目 。 当 项 目 被 选中 时 ， 程 序 将 把 该 项 目 添加 到 未 
分 配 表 列表 中 ， 然 后 通过 数据 库 链 接 执行 一 个 更 新 查询 完成 数据 库 中 组 别 字段 的 更 新 操作 ， 
最 后 程序 将 根据 更 新 后 的 数据 库 标 示 ， 重 新 显示 已 分 配 列表 。 

以 下 是 该 单 击 事 件 过 程 的 代码 解释 : 

Private Sub btn 删除 _Click() 


Dim itemlist As Listltem, strSQL As String 
On Error Resume Next 


rs.Close ' 关 闭 记录 集 
On Error GoTo 0 
For Each itemlist In List 已 分 配 表 .Listltems ' 逐 个 循环 已 分 配 表 的 项 目 
lfitemlistChecked Then 
"设置 更 新 查询 字符 串 


strSQL = "update 拆 分 表 set 组 名 =' 未 分 配 ' where 工作 表 名 =" & itemlistText & "$" 
List 未 分 配 表 .Listltems.Add Text:=itemlist.Text ' 在 未 分 配 表 列 表 中 添加 该 项 目 


cnn 临时 数据 往 .Execute strSQL ' 执 行 更 新 查询 
End If 
Next 
With List 已 分 配 表 .Listltems 
.Clear ' 清 空 已 分 配 表 项 目 


' 获 取 组 别 为 当前 选择 组 别 的 拆 分 表 记录 集 
rs.Open "select * from 拆 分 表 where 组 名 =" & comb 组 别 .Text & "", cnn 临时 数据 短 
If rs.RecordCount Then 


Do Until rs.EOF "循环 到 记录 集 末端 后 终止 
.Add Text:=Left(rs.Fields(" 工 作 表 名 "), Len(rs.Fields(" 工 作 表 名 ")) -1) ”为 列表 添加 新 项 目 
rs.MoveNext ' 移 动 到 下 一 条 记录 
Loop 
End If 
End With 
End Sub 
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12.4.9 开始 拆 分 按钮 单 击 事件 代码 设计 


【开始 拆 分 】 按 钮 的 单 击 事件 过 程 是 系统 
拆 分 模块 的 核心 过 程 。 单 击 该 按钮 后 ， 程 序 将 
对 已 经 保存 到 数据 库 中 的 信息 完成 拆 分 工作 。 
而 这 些 信 息 是 用 户 在 窗口 中 设置 的 一 个 数据 备 
份 。 该 过 程 的 流程 较为 复杂 ， 以 下 分 别 使 用 文 
字 与 流程 图 加 以 说 明 。 

在 对 程序 流程 加 以 说 明之 前 ， 需 要 将 该 过 
旺 的 设计 思路 讲述 一 下 。 首 先 打开 需 拆 分 的 工 
作 短 ， 然 后 按照 用 户 设置 的 拆 分 方式 即 各 个 工 
作 表 分 别 保存 到 哪儿 个 新 工作 秒 中 ， 依 次 建立 
几 个 新 工作 短 ， 并 把 对 应 工作 表 复 制 到 各 个 工 
作 短 中 即 完成 了 拆 分 工作 。 以 上 说 到 的 拆 分 设 
置 都 被 保存 到 了 数据 库 中 ， 因 而 需要 读 取 数 据 
库 信 息 。 

以 下 是 该 过 程 的 流程 文字 说 明 : 

昌 序 首先 从 数据 库 的 拆 分 表 中 获取 组 名 为 
“未 分 配 ” 的 所 有 记录 。 如 果 该 记录 集中 仍然 
有 记录 ， 说 明 用 户 还 没有 对 所 有 工作 表 做 相应 
设置 ， 此 时 需要 提示 用 户 完成 分 类 操作 ， 并 直 
接 退 出 过 程 ， 和 否则 程序 继续 后 续 代码 。 随 后 程 
序 开启 了 需要 拆 分 的 工作 德 、 从 拆 分 表 组 别 表 
中 获取 记录 集 以 及 获取 工作 短 的 后 缀 名 。 这 几 
个 变量 和 对 象 在 拆 分 时 将 被 调用 。 

接着 程序 检测 拆 分 表 组 别 记录 集 是 否 有 记 
录 。 值 得 注意 的 是 ， 这 里 的 组 别 对 应 的 就 是 
建 的 工作 敌 的 名 称 。 当 记录 集 存 在 记录 时 ， 程 
序 将 循环 所 有 记录 。 每 一 次 循环 中 ， 程 序 都 会 
从 数据 库 中 获取 当前 组 别 下 所 包含 的 所 有 工作 
表 名 ， 并 将 这 些 工作 表 从 拆 分 工作 筹 中 复制 到 
新 建 的 工作 筹 中 。 为 了 确保 新 建 的 工作 短 只 包 
含 指定 名 称 的 工作 表 ， 循 环 体 中 还 包含 了 如 何 
吻 除 新 建 工 作 簿 时 的 多 余 表 代 码 。 如 图 12-21 
所 示 的 是 该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 详细 代码 解释 : 


是 


获取 拆 分 表 中 组 名 与 rsTemp 组 
名 相同 的 所 有 记录 的 rs 记录 集 


复制 工作 表 到 工作 短 并 防止 该 表 
名 与 最 后 一 个 未 删除 多 余 表 重 名 


rs 记录 集 下 一 条 记录 


删除 工作 德 最 后 一 个 未 删除 表 
保存 并 关闭 工作 短 


rsTemp 下 一 条 记录 


【开始 拆 分 】 按 钮 单 击 事 件 过 程 流程 图 


图 12-21 
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Private Sub btn 开始 拆 分 _Click() 

Dim wk As Workbook, ws As Worksheet, wk2 As Workbook 

Dim rsTemp As New ADODB.Recordset, strSQL As String, DeletelD As String 
Application.ScreenUpdating = False 

Application.DisplayAlerts = False 

On Error Resume Next 


rs.Close 

On Error GoTo 0 

rs.Open "select * from 拆 分 表 where 组 名 =' 未 分 配 " ' 设 置 查询 字符 串 
Ifrs.RecordCount Then ' 检 测 记录 集 是 否 为 空 


MsgBox "还 有 未 被 分 配 的 表 存 在 ! 请 将 这 些 未 分 配 表 设 置 到 一 个 新 的 分 类 中 ! ", vblnformation + 
vbOKOnly, "存在 未 分 配 表 " 


Exit Sub 

End If 

Set wk = Workbooks.Open(txt 拆 分 工作 簿 ) "获取 工作 簿 对 象 

rsTemp.Open "select* from 拆 分 表 组 别 ", cnn 临时 数据 往 "获取 拆 分 表 组 别 记 录 集 

str 后 缀 = 文件 后 组 (txt 拆 分 工作 簿 ) "获取 工作 簿 后 缀 名 称 

If rsTemp.RecordCount Then "检测 拆 分 表 组 别 记录 集 是 否 为 空 
Do Until rsTemp.EOF "循环 所 有 拆 分 表 组 别 记录 集 


"设置 查询 记录 集 字符 串 ， 该 记录 集中 所 有 记录 的 组 名 应 该 等 于 reTemp 记录 集 的 组 名 
strSQL = "select* from 拆 分 表 where 组 名 =" & rsTemp.Fields(" 组 名 ") & "” 

On Error Resume Next 

rs.Close 

On Error GoTo 0 

rs.Open strSQL, cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic “获取 条 件 查询 记录 集 


Ifrs.RecordCount Then ' 检 测 记录 集 是 否 为 空 
Set wk2 = Workbooks.Add ' 新 增 工 作 簿 
wk2.SaveAs 保存 文件 名 (txt 拆 分 工作 秒 , rsTemp.Fields(" 组 名 ")) ' 按 组 名 保存 新 工作 秒 
Do Until wk2.Sheets.Count = 1 ' 检 测 工作 簿 是 否 只 有 一 个 表 

wk2.Sheets(1).Delete "删除 工作 簿 第 一 个 工作 表 
Loop 
DeletelD = wk2.Sheets(1).Name "记录 没有 删除 的 工作 表 的 名 称 
Do Until rs.EOF "循环 rs 记录 集 所 有 记录 
获取 需要 复制 工作 表 的 工作 表 对 象 
Set ws = wk.Worksheets(Left(rs.Fields(" 工 作 表 名 "), Len(rs.Fields(" 工 作 表 名 ")) -1)) 
If ws.Name = DeletelD Then "检测 该 工作 表 是 否 与 需 删 除 表 名 称 重 名 
wk2.Sheets(DeletelD).Name = DeletelD + "0" ' 修 改 需 删除 表 的 名 称 
DeletelD = DeletelD + "0" "记录 需 删除 表 的 新 名 称 
End If 
rs.MoveNext "将 记录 指针 移 到 下 一 条 
ws.Copy before:=wk2.Sheets(1) 复制 工作 表 到 新 工作 筹 中 
Loop 
End If 
wk2.Sheets(DeletelD).Delete "删除 原来 不 能 删除 的 多 余 工作 表 
wk2.Save 保存 新 工作 秒 
wk2.Close ' 关 闭 新 工作 簿 
rsTemp.MoveNext "将 rsTemp 记录 指针 移 到 下 一 条 
Loop 


End 上 f 
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wk.Close 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
MsgBox "保存 成 功 ! " 

End Sub 


12.4.10 文件 后 组 与 保存 文件 名 过 程 代码 设计 


设计 中 会 用 到 文件 后 级 与 保存 文件 名 两 个 自 定义 函数 。 文 件 后 级 函数 根据 传 入 的 工作 短 
文件 路 径 获取 该 文件 的 后 级 名 。 系 统 中 使 用 该 函数 获取 拆 分 工作 德 的 后 级 ， 以 确保 拆 分 出 来 
后 保存 所 得 的 工作 德 与 原 - 工作 德 文件 类 型 一 致 。 保 存 文件 名 函数 根据 传 入 的 拆 分 工作 短文 件 
路 径 和 组 别名 称 〈 即 保存 文件 的 名 称 ) ， 确 定 保存 文件 位 置 。 拆 分 出 来 的 工作 短文 件 将 位 于 
拆 分 工作 短 相 同文 件 夹 中 。 以 下 是 这 两 个 函数 的 代码 解释 : 

Private Function 文件 后 缀 (ByVal fleName As String) As String 


Dim i As Integer 

fleName = StrReverse(fileName) ' 反 向 文件 路 径 字 符 串 

i= InStr(1, fileName, ".") ' 获 取 反 向 路 径 字 符 串 第 一 个 “." 位 置 
fileName = StrReverse(Left(fileName, i -1)) ' 获 取 后 缀 名 字符 串 

文件 后 缀 = flename "设置 函数 返回 值 

End Function 


Private Function 保存 文件 名 (filePath As String, fleName As String) As String 


Dim i As Integer 

filePath = StrReverse(filePath) 吧 向 拆 分 工作 簿 路 径 字符 串 

i= InStr(1, filePath, \) ' 获 取 反 向 拆 分 工作 簿 路 径 字 符 串 第 一 个 “.” 位 置 
filePath = Left(StrReverse(filePath), Len(filePath) -i + 1) ' 获 取 排 除 文件 名 后 的 路 径 字符 串 
保存 文件 名 =filePath & fileName & "." & str 后 缀 "设置 保 存 工 作 敌 的 完成 路 径 

End Function 


12.5 ”选择 工作 簿 窗 体 设计 


选择 工作 短 窗 口 用 于 获取 需要 合并 工作 表 的 所 有 工作 短 。 在 该 窗口 中 ， 用 户 也 可 以 打开 
其 他 不 需要 合并 工作 表 的 工作 短 。 用 户 只 需要 在 进入 选择 工作 表 之 前 ， 将 这 些 工作 夭 取 消 选 
中 即 可 。 用 户 选 择 的 工作 敌 以 及 所 有 的 选中 状态 信息 都 会 被 记录 到 数据 库 中 ， 以 便 在 窗口 重 
显 时 读 取 。 


12.5.1 窗口 界面 设计 


窗口 中 共 包含 了 2 个 框架 控件 、2 个 复 选 框 控件 、2 个 单 选 按钮 控件 、1 个 ListView 控件 
和 2 个 按钮 控件 ， 如 图 12-22 所 示 。 窗口 的 控件 大 致 可 以 划分 为 4 块 ， 即 工作 敌 显 示 区 域 、 选 
中 设置 区 域 、 选 择 语言 区 域 和 按钮 区 。 这 些 控件 的 具体 说 明 如 表 12-6 所 示 。 
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名 称 


Ea 
口 合并 工作 短 2.xsx 。 FS 初稿 测试 文件 \ 合 并 工作 湾 2.xtx 
口 合 并 工作 淖 1.kx 。 F:\ 初 篇 \ 测 斌 文件 \ 合 并 工作 簿 1.xisx 


图 12-22 ”选择 备份 工作 秒 界 面 设计 
表 12-6 ”选择 备份 工作 簿 窗口 控件 列表 
控 件 名 | 控件 类 型 控件 说 明 
和 | ae | 于 显示 用 户 已 打开 工作 血 。 在 该 控件 中 用 户 还 可 以 勾 选 需要 备份 工 
| 作 表 的 工作 钴 ， 以 进入 下 一 步 中 设置 备份 的 工作 表 
Frame 选中 设置 | 框架 该 控件 包含 了 两 个 设 壮 工作 短 选 中 操作 的 复 选 框 控件 
”| 远 择 该 复 选 框 时 ， 将 自动 选中 所 有 ListView 控件 中 所 有 工作 血 。 当 用 户 手动 
全 癌 选 选 » 证 
chk 全 部 选中 。 | 复 选 框 。 | 将 Listview 控件 中 的 工作 秒 都 选中 时 ， 该 复 选 框 将 自动 被 选中 
”| 远 择 该 复 选 框 时 ， 将 自动 取消 所 有 ListView 控件 中 已 勾 选 工作 簿 。 当 用 户 于 
全 冯 选 框 
5 全 部 取消 。 | 复 选 框 。 | 动 将 Listview 控件 中 的 选中 工作 入 都 取消 时 ， 该 复 选 框 将 自动 被 选中 
frame 选择 语言 | 框架 | 该 框架 用 于 设置 语言 显示 。 它 包含 了 两 个 单 选 按钮 
选中 该 单 选 按钮 时 ， 将 把 当前 语言 设置 为 中 文 。 该 窗口 的 显示 将 立即 更 新 为 


op 中 文 单 选 按钮 申 立 


op 美文 Er 将 把 当前 语言 设置 为 英文 。 该 窗口 的 显示 将 立即 更 新 为 
单 击 该 按钮 后 ， 将 弹出 一 个 文件 路 径 获取 窗口 。 在 该 窗口 中 用 户 选择 一 个 或 
btn 打开 按钮 多 个 工作 敌后 ， 这 些 工作 血 的 名 称 和 路 径 将 会 被 记录 在 数据 库 中 。 并 在 窗口 
列表 中 显示 出 来 
单 击 该 按钮 后 ， 将 进入 工作 表 选 择 窗口 中 。 用 户 可 以 在 该 窗口 中 设置 各 个 工 
btn 下 一 步 按钮 


作 短 中 需要 备份 的 工作 表 


建立 该 窗口 的 步 又 如 下 : 

(1) 在 Excel2007 的 VBE 开发 环境 中 依次 选择 【插入 】| 【用户 窗 体 】 命 令 。 在 属性 面 
板 中 修改 窗口 名 称 为 “frm 选择 工作 秒 ”， 如 图 12-23 所 示 。 
(2) 在 工具 箱 中 选择 ListView 控件 。 在 窗 体 的 上 部 插入 一 个 ListVeiw 控件 后 , 在 属性 窗 
口中 将 其 名 称 属性 修改 为 “List 工作 每 ”，CheckBoxes 属性 设置 为 True， 如 图 12-24 所 示 。 
该 属性 设置 为 True 时 ，ListView 控件 的 每 个 项 目前 都 会 出 现 一 个 复 选 框 。 
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图 12-23 ”选择 工作 德 窗 体 属性 设计 图 12-24 ListView 控件 属性 设计 示意 图 
(3) 在 工具 箱 中 选择 框架 控件 。 在 靠近 ListView 控件 的 下 方 连续 插入 两 个 框架 控件 。 在 
属性 窗口 中 将 控件 的 名 称 属 性 依次 设置 为 “Frame 勾 选 设置 ”和 “frame 选择 语言 ”， 然 后 将 
其 Caption 属性 依次 设置 为 “ 勾 选 设置 ，” 和 “选择 语言 ，”， 如 图 12-25 所 示 。 
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图 12-25 选择 工作 短 窗 体 设计 效果 


(4) 在 工具 箱 中 选中 复 选 框 控件 ， 在 “ 勾 选 设置 ”框架 中 连续 插入 两 个 复 选 框 。 随 后 在 
属性 窗口 中 设置 名 称 属性 依次 为 “chk 全 部 勾 选 ”和 “chk 全 部 取消 ”，Caption 属性 依次 设置 
为 “全 部 勾 选 ”和 “chk 全 部 取消 ”。 

(5) 在 工具 箱 中 选择 单 选 框 控件 ， 在 “选择 语言 ”框架 中 连续 插入 两 个 复合 框 。 随 后 在 
属性 窗口 中 设置 其 名 称 属性 依次 为 “op 中 文 ” 和 “op 英文 ”，Caption 属性 依次 设置 为 “中 文 ” 
和 “英文 ”。 

(6) 在 工具 箱 中 选择 按钮 控件 并 在 窗口 底部 连续 插入 两 个 按钮 。 随 后 在 属性 窗口 设置 名 
称 属性 依次 为 “btn 打开 ”和 “btn 下 一 步 ”，Caption 属性 依次 设置 为 “打开 ”和 “下 一 步 ”。 


12.5.2 ”窗口 事件 代码 设计 


窗口 相关 的 过 程 包括 了 3 个 事件 代码 ， 分 别 是 窗口 初始 化 事件 、 窗 口 激活 事件 和 窗口 扼 
载 事 件 。 这 3 个 事件 的 功能 描述 如 下 : 
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口 ”窗口 初始 化 事件 ， 该 事件 首先 建立 到 本 工作 敌 的 链接 ， 该 链接 在 设置 语言 显示 时 被 
使 用 ， 然 后 程序 初始 化 了 一 些 公共 变量 的 初始 值 与 控件 的 初始 状态 。 

口 ” 窗 口 激活 事件 ， 当 窗口 被 激活 时 ， 程 序 将 调用 刷新 窗口 语言 显示 过 程 刷 新 窗口 显示 ， 
然后 再 刷新 ListView 控件 ， 其 中 分 标题 刷新 和 列表 项 目 刷新 ， 最 后 设置 了 窗口 中 各 
个 控件 状态 。 

口 ”窗口 卸载 事件 ， 窗 口 扼 载 时 ， 程 序 通过 一 个 ff 语句 确保 了 备份 工作 表 中 的 3 个 窗口 
只 有 一 个 被 显示 。 

以 下 是 这 3 个 事件 过 程 的 代码 解释 : 

Private Sub UserForm_lnitialize() 


On Error Resume Next 
cnn 主 工作 简 .Open GetConnString(ThisWorkbook.FullName) ' 获 取 到 当前 工作 簿 的 链接 


op 中 文 .Value = True "设置 中 文 设置 单 选 框 的 状态 
languageset = False ' 将 语言 设置 为 中 文 显示 (中 为 为 False) 
btn 下 一 步 .Enabled = False "设置 下 一 步 按钮 的 可 用 状态 
On Error GoTo 0 

End Sub 

Private Sub UserForm Activate() 

刷新 窗 体 语言 显示 Me "刷新 窗口 语言 显示 

ListView 标题 刷新 ' 刷 新 ListView 控件 的 标题 

刷新 工作 往 列 表 ' 刷 新 ListView 控件 的 项 目 

设置 控件 状态 "设置 窗口 中 其 他 控件 的 状态 

End Sub 


Private Sub UserForm_Terminate() 

If UserForms.Count = 3 Then ' 窗 口中 有 3 个 窗口 时 ， 御 载 保存 位 置 窗口 
Unload frm 保存 位 置 

Elself UserForms.Count = 2 Then 
Unload frm 选择 工作 表 ' 窗 口中 有 两 个 窗口 时 ， 扼 载 选 择 工作 表 窗 口 

End 上 

Unload Me "卸载 选择 工作 簿 窗口 

End Sub 


12.5.3 ”工作 筹 列表 控件 代码 设计 


相关 工作 敌 列 表 控件 的 代码 包含 了 3 个 过 程 ， 分 别 是 ， 列表 项 目 勾 选 事件 、 列 表 项 目 选 
择 事 件 、ListView 标题 刷新 过 程 。 这 3 个 过 程 的 作用 描述 如 下 : 

口 ”列表 项 目 勾 选 事件 ， 当 在 工作 敌 列 表 中 选中 了 某 个 项 目 时 ， 事 件 被 激发 。 该 事件 将 
只 完成 一 个 任务 ， 即 重新 设置 控件 状态 。 程 序 并 没有 在 这 里 重新 设置 数据 库 中 对 应 
该 被 选中 工作 德 的 是 否 选 中 字段 ， 而 是 选择 在 单 击 【 下 一 步 】 按 钮 时 集中 修改 。 

口 ”列表 项 目 选择 事件 : 选择 列表 项 目 时 ， 程 序 只 设置 了 该 项 目的 提示 文本 。 该 文本 将 
在 鼠标 在 该 项 目 上 停留 一 定时 间 后 被 显示 。 

口 “ListView 标题 刷新 过 程 : 标题 刷新 过 程 重 新 设置 了 ListView 控件 的 显示 参数 ， 并 且 
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重 置 了 该 控件 的 标题 。 
以 下 是 这 3 个 过 程 的 代码 解释 : 
Private Sub List 工作 短 _ltemCheck(ByVal ltem As MSComctlLib.Listltem) 


设置 控件 状态 "调用 设置 控件 状态 过 程 
End Sub 
Private Sub List 工作 筹 _ltemClick(ByVal ltem As MSComctlLib.Listltem) 
ltem.TooltipText = ltem.Subltems(1) "设置 项 目 提 示 文 本 
End Sub 
Private Sub ListView 标题 刷新 () 
With Me.List 工作 簿 
.Gridlines = True ' 显 示 网 格 线 
.FullRowSelect = True ' 允 许 整 行 选择 
.MultiSelect = True ' 允 许多 行 选择 
.LabelEdit = lwwManual 单 击 项 目 时 ， 不 进入 编辑 状态 
.View = lvwwReport "设置 控件 显示 模式 
With .ColumnHeaders 
.Clear ' 清 除 控件 标题 
lflanguageset Then 
.Add Text:="Name" "设置 英文 显示 的 名 称 栏 标 题 
.Add Text:="Path", Width:=255 "设置 英文 显示 的 路 径 栏 标题 
Else 
.Add Text:=" 名 称 " "设置 中 文 显 示 的 名 称 栏 标 题 
.Add Text:=" 路 径 ", Width:=255 ' 设 置 中 文 显示 的 路 径 栏 标题 
End If 
End With 
End With 
End Sub 


12.5.4 选中 设置 与 语言 设置 框架 代码 设计 


选中 设置 和 语言 设置 框架 中 包含 了 2 个 复 选 框 和 2 个 单 选 按钮 。 这 些 按钮 被 选中 时 都 需 
要 执行 一 部 分 代码 完成 特定 任务 。2 个 复 选 框 被 选中 时 , 程序 需要 修改 ListView 控件 中 项 目的 
选中 状态 以 及 下 一 部 按钮 的 可 用 状态 。2 个 单 选 按钮 被 选中 时 ， 需 要 重新 显示 窗口 语言 以 及 
ListView 标题 的 语言 。 这 些 代码 都 比较 简单 。 这 里 不 再 列 出 各 个 过 程 的 流程 图 ， 以 下 将 通过 文 
字 加 以 介绍 。 

口 全 部 勾 选 和 全 部 取消 复 选 框 单 击 事件 ， 程序 首先 检测 全 部 勾 选 (全 部 取消 ) 复 选 框 
的 值 。 如 果 为 真 ， 说 明 全 部 勾 选 (全 部 取消 ) 复 选 框 被 选中 。 此 时 ， 程 序 将 首先 修 
改 全 部 取消 (全 部 勾 选 ) 复 选 框 的 值 ， 然 后 程序 循环 工作 禾 列 表 中 所 有 项 目 ， 对 于 
未 选中 选中) 的 项 目 将 设置 为 选中 (未 选中 ) 。 最 后 程序 将 设置 【下 一 步 】 按 钮 
可 用 (不 可 用 ) 。 

口 ” 中文 和 英文 单 选 按 钮 单 击 事件 : 中文 (英文) 单 选 按钮 被 单 击 时 ， 首 先 设置 语言 设 


置 公共 变量 为 假 ( 真 )， 然 后 程序 刷新 了 控件 中 所 有 控件 的 Caption 属性 ， 最 后 程序 
将 ListView 控件 的 显示 标题 也 修改 为 中 文 〈 英 文 ) 。 
以 下 是 这 4 个 单 击 事件 过 程 的 代码 解释 : 


Private Sub chk 全 部 勾 选 _Click() 
Dim itemlist As Listltem 
If chk 全 部 勾 选 .Value Then 
chk 全 部 取消 .Value = False 
For Each itemlist In List 工作 简 .Listltems 
lfitemlist.Checked = False Then 
itemlist.Checked = True 
End If 
Next 
btn 下 一 步 .Enabled = True 
End If 
Set itemlist = Nothing 
End Sub 


Private Sub chk 全 部 取消 _Click() 
Dim itemlist As Listltem 
If chk 全 部 取消 .Value Then 
chk 全 部 勾 选 .Value = False 
For Each itemlist In List 工作 簿 .Listltems 
lfitemlist.Checked Then 
itemlist.Checked = False 
End If 
Next 
btn 下 一 步 .Enabled = False 
End If 
Set itemlist = Nothing 
End Sub 


Private Sub op 英文 _Click() 
languageset = True 
刷新 窗 体 语言 显示 Me 
ListView 标题 刷新 

End Sub 


Private Sub op 中 文 _Click() 
languageset = False 
刷新 窗 体 语言 显示 Me 
ListView 标题 刷新 

End Sub 


12.5.5 ”打开 与 下 一 步 按 钮 代码 设计 


窗口 中 共 包 含 了 两 个 按钮 : 


检测 全 部 复 选 框 是 否 选中 
"取消 选中 全 部 复 选 框 


检测 项 目 是 否 未 选中 
"设置 项 目 被 选中 


' 设 置 下 一 步 按钮 可 用 


检测 全 部 复 选 框 是 否 取消 选中 
选中 全 部 复 选 杠 


检测 项 目 是 否 选中 
' 设 置 项 目 未 选中 


' 设 置 下 一 步 按钮 不 可 用 


"设置 语言 设置 公共 变量 为 真 
' 刷 新 窗口 所 有 控件 Caption 属性 为 英文 显示 
' 刷 新 ListView 控件 标题 栏 文本 为 英文 显示 


' 设 置 语言 设置 公共 变量 为 假 
' 刷 新 窗口 所 有 控件 Caption 属性 为 中 文 显示 
' 刷 新 ListView 控件 标题 栏 文本 为 中 文 显示 


【打开 】 按 钮 和 【下 一 步 】 按 钮 。 这 些 按钮 被 单 击 后 ， 分 别 
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完成 各 自 的 功能 。 这 些 按钮 的 功能 描述 如 下 : 


口 打开 按钮 单 击 事件 : 调用 Excel 2007 的 内 部 函数 GetOpenFileName。 该 函数 将 开启 一 
个 【打开 文件 】 对 话 框 ， 用 户 选 择 了 文件 后 ， 函 数 返 回 选择 文件 的 路 径 。 程 序 中 将 
这 个 返回 值 保 存 到 了 一 个 Variant 数据 类 型 的 变量 中 。 因 为 用 户 可 能 选择 了 多 个 文件 ， 
此 时 这 个 返回 值 将 是 一 个 数组 。 然 后 程序 将 把 这 些 工 作 短 保存 到 数据 库 中 ， 最 后 刷 
新 工作 短 列 表 中 的 项 目 。 

口 下 一 步 按钮 单 击 事件 ， 单 击 【下 一 步 】 按 钮 后 ， 程 序 首先 保存 选中 工作 短 到 数据 库 
中 ， 然 后 隐藏 了 选择 工作 敌 窗 口 ， 最 后 将 选择 工作 表 窗 口 显 示 出 来 。 

以 下 是 这 两 个 按钮 单 击 事件 过 程 的 代码 解释 : 

Private Sub btn 打开 _Click() 

On Error GoTo ExitSub_Handle 

' 打 开工 作 簿 路 径 获 取 窗 口 ， 并 将 选择 工作 簿 保存 到 公共 变量 中 

arr 选择 工作 往 = Application.GetOpenFilename("Excel2000-2007 file(*.xls;*.xlsx),*.xls;*.xlsx", 

MultiSelect:=True) 


Application.ScreenUpdating = False "禁止 Excel 程序 自动 刷新 显示 
保存 选择 工作 简 "保存 打开 工作 秒 到 数据 库 中 
刷新 工作 簿 列表 "刷新 工作 簿 列表 项 目 显示 
Application.ScreenUpdating = True "恢复 Excel 程序 自动 刷新 


ExitSub_ Handle: 
On Error GoTo0 


End Sub 

Private Sub btn 下 一 步 _Click() 

保存 选中 工作 簿 ' 调 用 保存 选中 工作 筹 过 程 
Me.Hide ' 隐 藏 选择 工作 簿 窗口 

frm 选择 工作 表 .Show ' 显 示 选 择 工作 表 窗 口 

End Sub 


12.5.6 ”设置 控件 状态 过 程 代码 设计 


设置 控件 状态 过 程 用 于 完成 对 窗口 中 控件 状态 的 设置 。 窗 口中 设置 控件 状态 的 控件 数量 


不 多 。 包括 【 下 一 步 】 按 钮 的 可 用 状态 、【 全 部 勾 选 】 与 【全 部 取消 】 复 选 框 的 勾 选 状态 。 


程序 首先 计算 出 工作 簿 列表 中 被 勾 选项 目的 数量 。 然 后 当 该 数 大 于 0 时 ，【 下 一 步 】 按 


钮 被 设置 为 可 用 。 当 该 数 等 于 列表 的 项 目 总 数 时 ，【 全 部 勾 选 】 复 选 框 被 设置 为 勾 选 ， 而 【全 
部 取消 】 复 选 框 被 设置 为 未 勾 选 。 当 该 数 等 于 0 时 ，【 全 部 取消 】 复 选 框 被 设置 为 勾 选 ， 而 
【全 部 勾 选 】 复 选 框 被 设置 为 未 勾 选 。 此 时 【下 一 步 】 按 钮 也 被 设置 为 不 可 用 。 如 果 该 数 处 
于 0 与 工作 簿 列表 项 目 总 数 之 间 时 ， 两 个 复 选 框 都 被 设置 为 未 选中 。 


以 下 是 该 过 程 的 代码 解释 : 

Private Sub 设置 控件 状态 () 

Dim itemlist As Listltem, checkCount As Integer 

For Each itemlist In List 工作 短 .Listtems "循环 所 有 工作 簿 列表 中 的 项 目 
If itemlist.Checked Then "检测 项 目 是 否 选中 


= 
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checkCount = checkCount+ 1 "累计 选中 项 目 数 
End 上 f 
Next 
If checkCount Then btn 下 一 步 .Enabled = True "选中 项 目 数 大 于 0 时 ， 下 一 步 按 钮 可 用 
If checkCount = List 工作 簿 .Listltems.Count Then ' 检 测 项 目 是 否 被 全 部 选中 
chk 全 部 勾 选 .Value = True ' 选 中 全 部 复 选 框 
chk 全 部 取消 .Value = False ' 取 消 选 中 全 部 复 选 框 
End 上 f 
If checkCount = 0 Then "检测 项 目 是 否 全 部 取消 选中 
chk 全 部 勾 选 .Value = False ' 选 中 全 部 复 选 框 
chk 全 部 取消 .Value = True ' 取 消 选 中 全 部 复 选 框 
btn 下 一 步 .Enabled = False "下 一 步 按钮 不 可 用 
End If 


' 检 测 被 勾 选 项 目 数 是 否 落 在 0 与 总 项 目 数 间 
If checkCount > 0 And checkCount < List 工作 簿 .Listltems.Count Then 


chk 全 部 勾 选 .Value = False ' 选 中 全 部 复 选 框 

chk 全 部 取消 .Value = False ' 取 消 选中 全 部 复 选 框 
End 上 
End Sub 


12.6 选择 工作 表 窗 体 设 计 


选择 工作 表 窗 口 用 于 获取 需要 备份 的 各 个 工作 表 。 用 户 需 要 在 该 窗口 中 选择 对 应 的 工作 
筹 ， 然 后 在 该 工作 短 中 选择 相应 工作 表 。 这 些 需 要 备份 保存 的 工作 表 将 会 被 数据 库 记 录 ， 这 
些 数据 在 进入 下 一 步 设置 工作 筹备 份 位 置 过 程 中 被 调用 。 


12.6.1 窗口 界面 设计 


窗口 包含 了 1 个 框架 控件 、2 个 复 选 框 控件 、1 个 复合 框 控件 、1 个 ListView 控件 和 2 个 
按钮 。 表 12-7 对 窗口 中 包含 的 所 有 控件 进行 了 具体 的 说 明 。 如 图 12-26 所 示 为 该 窗 体 的 界面 。 


表 12-7 ”选择 工作 表 窗 体 控件 列表 


控 件 名 | 控件 类 型 控件 说 明 
List 选 定 工作 血 | 复合 框 该 复合 框 中 包含 了 前 面 所 有 被 选中 的 工作 禾 。 复 合 框 中 选择 工作 敌后 ， 未 分 
配 工 作 表 列 表 将 自动 刷新 
List 工作 表 ListView 该 控件 用 于 显示 当前 选 定 工作 短 下 未 分 配 的 所 有 工作 表 
Frame 勾 选 设置 | 框架 该 框架 包含 两 设置 选中 方式 复 选 框 
chk 全 部 勾 选 ”| 复 选 框 用 户 单 击 该 复 选 框 后 ， 程 序 自动 选中 工作 表 列 表 中 所 有 工作 表 
chk 全 部 取消 ”| 复 选 框 月 户 单 击 该 复 选 框 后 ， 程 序 自动 取消 工作 表 列 表 中 所 有 工作 表 的 选中 
btn 工 作 表 上 一 步 | 按钮 用 户 单 击 该 按钮 后 ， 可 以 退回 和 到 上 一 步 工 作 短 设置 对 话 框 中 
btn 工 作 表 下 一 步 | 按钮 月 户 单 击 该 按钮 后 ， 将 打开 合并 工作 德 位 置 设置 对 话 框 
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图 12-26 选择 工作 表 窗 体 界面 
建立 该 窗口 的 步骤 如 下 : 


(1) 在 Excel2007 的 VBE 开发 环境 中 依次 选择 【插入 】|【 用 户 窗 体 】 命 令 ， 然 后 在 属 
性 窗口 中 设置 该 窗口 的 名 称 为 “frm 选择 工作 表 ”， 如 图 12-27 所 示 。 


(2) 在 工具 箱 中 选择 标签 控件 并 在 窗 体 中 连续 插入 两 个 标签 控件 。 在 属性 窗口 依次 设置 
两 个 标签 的 Caption 属性 为 “当前 工作 德 : ”和 “选择 工作 表 : ”， 如 图 12-28 所 示 。 


这 撞 工 作 表 (Userfoni 有 [| 


尾 性 - frm 选 择 工作 表 上 | 
VserF 


fr = 


0 ~ faborderStyl. 
VserFornl 


图 12-27 选择 工作 表 窗 体 属性 设计 图 12-28 选择 工作 表 窗 体 设计 效果 


(3) 在 工具 箱 中 选择 复合 框 控件 并 在 窗 体 当前 工作 短 
标签 下 插入 一 个 复合 框 控 件 。 在 属性 窗口 中 设置 该 控件 的 名 
称 为 “List 选 定 工作 短 ”, SelectionMargin 属性 设置 为 False， 
如 图 12-29 所 示 。 


(4) 在 工具 箱 中 选择 ListView 控件 并 在 “ 选 定 工作 短 ” 


2 ~ fnSpecialEff 


Es 2 二 nstyleDropD' S| 
复合 框 下 方 插入 一 个 ListView 控件 ,在 属性 窗口 中 设置 该 控 


件 的 名 称 为 “List 工作 表 ” ， 如 图 12-30 所 示 。 图 12-29 设置 复合 框 控件 的 
(5) 在 工具 箱 中 选择 框架 控件 。 在 刚 插入 的 ListView SelectionMargin 属性 


控件 右 侧 插 入 一 个 框架 控件 。 随 后 在 属性 窗口 中 设置 该 框架 的 名 称 为 “Frame 勾 选 设置 ”， 如 
图 12-31 所 示 。 
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图 12-30 ListView 控件 属性 设计 图 12-31 框架 控件 属性 设计 
(6) 在 工具 箱 中 选中 复 选 框 控件 ， 在 刚 插 入 的 框架 控件 中 连续 插入 两 个 复 选 框 控件 。 随 


后 在 属性 窗口 中 设置 两 控件 的 名 称 属性 依次 为 “chk 全 部 勾 选 ” 和 “chk 全 部 取消 ”。 

(7) 在 工具 箱 中 选择 按钮 控件 ， 在 刚 插 入 的 框架 控件 下 面 连续 插入 两 个 按钮 控件 。 在 属 
性 窗口 中 依次 设置 两 按钮 的 Caption 属性 为 “上 一 步 ” 和 “下 一 步 ”, 名 称 属性 依次 设置 为 “btn 
工作 表 上 一 步 ” 和 “btn 工作 表 下 一 步 ”。 


12.6.2 ”窗口 激活 与 卸载 事件 代码 设计 


窗口 代码 中 包含 了 两 个 有 关 窗 口 事件 的 过 程 。 它 们 是 窗口 激活 事件 和 窗口 卸载 事件 。 这 
两 过 程 的 功能 描述 如 下 : 

口 ”窗口 激活 事件 ， 当 窗口 被 重新 激活 时 ， 需 要 刷新 窗 体 语言 显示 及 标题 、 重 新 刷新 选 
定 工 作 短 复合 框 的 项 目 。 程 序 首先 调用 刷新 窗 体 语 言 显示 公共 过 程 完成 窗 体 语言 显 
示 刷 新 工作 夭 ， 再 调用 刷新 标题 刷新 了 本 窗 体 中 ListView 控件 的 标题 ， 然 后 打开 到 
数据 库 中 工作 秒表 的 记录 集 ， 该 记录 和 集 的 是 否 选 定 字 段 为 True。 接 着 将 该 记录 集中 
所 有 工作 短路 径 依次 作为 列表 的 项 目 添加 进去 。 

口 ”窗口 卸载 事件 ， 当 窗口 被 卸载 时 ， 程 序 需 要 保证 备份 模块 中 包含 的 3 个 窗口 都 被 关 
闭 。 程 序 首先 检测 窗口 数量 ， 数 量 为 3 时 ， 说 明 保存 工作 短 窗 口 被 打开 了 ， 首 先 需 
要 关闭 该 窗口 ， 然 后 依次 卸载 该 窗口 自身 和 选择 工作 德 窗口 。 这 里 没有 必要 检测 窗 
口 数 为 2 或 1 时 的 情况 。 

以 下 是 这 两 个 事件 的 代码 解释 : 

Private Sub UserForm_Activate() 

刷新 窗 体 语 言 显示 Me ' 刷 新 窗 体 语言 显示 

刷新 标题 ' 刷 新 ListView 控件 的 标题 


获取 到 工作 秒表 的 记录 集 ， 该 记录 集 的 是 否 选 定 字段 为 True 
rs.Open "select * from [工作 筹 ] where 是 否 选 定 =TRUE", cnn 临时 数据 簿 , adOpenKeyset, 


adLockOptimistic 
With List 选 定 工作 简 
.Clear "清除 列表 所 有 项 目 
Do Until rs.EOF ' 当 到 达 记 录 集 末端 时 ， 结 束 循环 
.Addltem rs.Fields(" 工 作 敌 路径”) 为 列表 添加 新 项 目 
rs.MoveNext ' 将 记录 移动 到 下 一 条 
Loop 
.Listindex = 0 ' 软 认 显示 值 为 第 一 条 项 目 
End With 


办公 应 用 强 党 之 稍 . 
Excel VBA 应 用 开发 经 典 案例 


Set rs = Nothing 


End Sub 

Private Sub UserForm Terminate() 

If UserForms.Count = 3 Then ' 检 测 是 否 有 3 个 窗 体 被 同时 显示 
Unload frm 保存 位 置 ' 拖 载 保存 位 置 窗口 

End 上 f 

Unload Me "卸载 本 窗口 

Unload frm 选择 工作 簿 ' 拖 载 选择 工作 秒 窗 口 

End Sub 


12.6.3 ”复合 框 改变 事件 代码 设计 


工作 短 复 合 框 中 包含 了 所 有 在 选择 工作 短 窗 口中 选中 的 工作 短 。 当 用 户 在 该 控件 中 改变 
选择 后 ， 程 序 需要 刷新 工作 表 列 表 项 目 显示 。 该 刷新 显示 工作 一 方面 要 将 该 工作 短 的 所 有 工 
作 表 的 名 称 体现 出 来 , 另 一 方面 还 需要 设置 各 个 工作 表 的 选 定 状态 。 如 图 12-32 所 示 是 该 过 程 
的 流程 图 。 


一 还 定 工作 敌 复 合 框 是否 为 空 ? 
获取 选 定 工作 短 的 Catalog 对 象 
清空 工作 表 列 表 复合 框 项 目 


获取 Catalog 表 集合 的 首 个 表 table 表 


GE 天 不 在 Catalog 表 集合 来 疆 7 


是 
为 工作 表 列 表 复合 框 添加 项 目 


ec 


从 数据 库 工作 表 中 获取 满足 指 
定 路 径 与 名 称 的 rs 记录 集 


根据 记录 集 是 否 有 记录 决定 工作 表 列 
表 中 该 工作 表 项 目 是 否 被 选中 


table 表 对 象 移动 到 Catalog 
表 集合 的 下 一 个 表 


图 12-32 复合 框 改变 事件 过 程 流程 图 


Ah 
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以 下 是 该 过 程 的 代码 解释 : 

Private Sub List 选 定 工作 往 _Change() 

If Trim(List 选 定 工作 簿 .Text) = " Then Exit Sub ' 选 定 工作 短 复 合 框 为 空 时 ， 退 出 过 程 
On Error Resume Next 

Dim catalog As New ADOX.catalog, table As New ADOX.table 

Dim strSQL As String 

获取 选 定 工作 得 的 Catalog 对 象 并 且 清 空 工作 表 列 表 中 所 有 项 目 

catalog.ActiveConnection = GetConnString(List 选 定 工作 筹 .Text) ”获取 Catalog 对 象 


List 工作 表 .Listltems.Clear "清空 工作 表 列表 项 目 
For Each table In catalog.Tables "循环 选 定 工作 簿 的 所 有 表 
With List 工作 表 .Listltems.Add(Text:=Left(table.Name, Len(table.Name) -1)) 
为 工作 表 列 表 添加 项 目 
strSQL = "select* from [工作 表 ] where 工作 短路 径 ="” & List 选 定 工作 簿 .Text& _ 
"and 工作 表 名 =" & table.Name & "" 生成 条 件 查询 字符 串 
rs.Close 关闭 记录 集 
rs.Open strSQL, cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic 和 打开 记录 集 
Ifrs.RecordCount > 0 Then 愉 测 记录 集 是 否 有 记录 
.Checked = True ' 设 置 新 项 目 为 被 选中 状态 
Else 
.Checked = False ' 设 置 新 项 目 为 未 选中 
End If 
End With 
Next 
设置 表 名 显示 状态 ' 设 置 窗口 其 他 控件 的 显示 状态 


On Error GoTo 0 

Set table = Nothing 
Set catolog = Nothing 
End Sub 


12.6.4 工作 表 列 表 、 选 中 设置 与 按钮 代码 设计 


该 小 节 包 含 了 窗口 工作 表 列表 、 勾 选 设置 框架 中 控件 与 两 按钮 的 代码 。 这 些 代 码 都 比较 简 
单 且 代码 不 多 ， 因 而 将 其 归纳 到 一 个 小 节 加 以 介绍 。 下 面 将 分 别 介绍 这 几 个 控件 代码 的 功能 : 
口 “工作 表 列表 项 目 勾 选 事件 : 用 户 在 选中 了 工作 表 列 表 时 ， 将 意味 着 该 工作 表 将 会 被 
最 终 合并 到 备份 工作 竹中。 此 时 需要 将 该 工作 表 的 名 称 以 及 所 属 工作 簿 的 路 径 保 存 
到 数据 库 中 ， 以 便 在 备份 工作 短工 作 中 调用 。 最 后 程序 还 需要 重新 设置 窗口 中 其 他 
控件 的 显示 状态 。 
口 ”全 部 勾 选 、 全 部 取消 复 选 框 单 击 事件 ， 勾 选 设置 框架 中 包含 的 这 两 个 复 选 框 被 单 击 
时 ， 程 序 需 要 按 该 设置 完成 项 目 勾 选 设置 。 其 工作 的 流程 类 似 ， 这 里 只 对 全 部 选中 
的 工作 流程 加 以 说 明 ， 首 先 程序 检测 【全 部 勾 选 】 复 选 框 的 值 是 否 为 真 ， 为 真 时 ， 
程序 将 【全 部 取消 】 复 选 框 值 设 置 为 假 。 然 后 循环 检测 工作 表 列 表 中 所 有 项 目 ， 项 
目 未 被 选中 时 ， 修 改 该 项 目 为 选中 并 通过 调用 添加 删除 选 定 项 过 程 保存 该 设置 。 
口 上 一 步 、 下 一 步 按钮 单 击 事件 : 单 击 【 上 一 步 】 按 钮 将 退回 到 工作 矢 选 择 窗口 中 ， 
重新 选择 需 备 份 工作 表 的 工作 短 。 单 击 【下 一 步 】 按 钮 将 进入 备份 工作 簿 位 置 设置 


A83 


对 话 框 中 。 
以 下 是 这 些 过 程 的 代码 解释 : 
Private Sub List 工作 表 _ltemCheck(ByVal ltem As MSComctlLib.Listltem) 


添加 删除 选 定 项 ltem ' 将 选 定 项 目 信息 写 入 数据 库 中 
设置 表 名 显示 状态 "设置 窗口 其 他 控件 的 显示 状态 
End Sub 
Private Sub chk 全 部 勾 选 _Click() 
Dim itemlist As Listltem 
If chk 全 部 勾 选 Then ' 检 测 全 部 勾 选 复 选 框 值 是 否 为 真 
chk 全 部 取消 .Value = False "设置 全 部 取消 复 选 框 值 为 假 
For Each itemlist In List 工作 表 .Listltems "循环 工作 表 列表 中 所 有 项 目 
If itemlist.Checked = False Then ' 检 测 项 目 Checked 属性 是 否 为 假 
itemlist.Checked = True ' 设 置 项 目 为 被 选中 
添加 删除 选 定 项 itemlist ' 将 该 项 目的 信息 写 入 数据 库 
End If 
Next 
End If 
End Sub 
Private Sub chk 全 部 取消 _Click() 
Dim itemlist As Listltem 
If chk 全 部 取消 Then ' 检 测 全 部 取消 复 选 框 值 是否 为 真 
chk 全 部 勾 选 .Value = False "设置 全 部 勾 选 复 选 框 值 为 假 
For Each itemlist In List 工作 表 .Listltems "循环 工作 表 列表 中 所 有 项 目 
If itemlist.Checked Then ' 检 测 项 目 Checked 属性 是 否 为 真 
itemlist.Checked = False "设置 项 目 为 未 选中 
添加 删除 选 定 项 itemlist ' 将 该 项 目的 信息 从 数据 库 中 删除 
End If 
Next 
End If 
End Sub 
Private Sub btn 工作 表 上 一 步 _Click() 
frm 选择 工作 往 .Show ' 显 示 选 定 工 作 簿 窗口 
Me.Hide ' 隐 藏 本 窗口 
End Sub 
Private Sub btn 工作 表 下 一 步 _Click() 
Unload Me "卸载 本 窗口 
frm 保存 位 置 .Show "显示 保存 位 置 窗口 
End Sub 


12.6.5 ”刷新 标题 过 程 代码 设计 


刷新 标题 过 程 用 于 重新 设置 选择 工作 表 窗口 中 ListView 控件 的 显示 设置 与 标题 显示 。 该 
刷新 标题 过 程 和 先前 各 个 包含 ListView 控件 中 的 刷新 标题 过 程 类 似 。 以 下 是 该 过 程 的 代码 解释 : 


aaa 


Ah 
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Private Sub 刷新 标题 () 


With List 工作 表 
.Gridlines = True ' 显 示 网 格 线 
.View = lvwReport "设置 显示 模式 
.FullRowSelect = True "允许 整 多 行 选择 
.MultiSelect = True ' 允 许多 行 选择 
.LabelEdit = lywManual ' 单 击 项 目 时 不 进入 编辑 状态 
End Sub 


12.6.6 ”设置 表 名 显示 状态 过 程 代码 设计 


设置 表 名 显示 状态 过 程 用 于 设置 窗口 选中 设置 中 两 个 复 选 框 的 选中 状态 ， 该 过 程 仅仅 只 
是 从 工作 表 列 表 中 项 目的 选中 数量 来 决定 选中 设置 框架 中 复 选 框 的 值 。 过 程 首先 通过 一 个 For 
循环 计算 出 工作 表 列 表 中 被 选中 项 目的 数量 , 然后 通过 几 个 下 判断 语句 确定 两 个 复 选 框 的 值 。 
如 图 12-33 所 示 的 是 该 过 程 的 流程 图 。 


获取 工作 表 列表 第 一 个 项 目 itemlist 


itemlist 是 否 为 工作 表 列 表 最 后 一 个 项 目 ? 
是 
ftemList 项 目 是 否 被 选中 ? 


记录 被 选中 项 目的 数量 checkCount 
itemList 移 动 到 下 一 个 项 目 


根据 checkCount 确 定 全 部 取消 与 
全 部 多 选单 选 按钮 的 选中 状态 


图 12-33 设置 表 名 显示 状态 过 程 流程 图 
以 下 是 该 过 程 的 代码 解释 : 


Private Sub 设置 表 名 显示 状态 () 
Dim itemlist As Listltem, checkCount As Integer 


For Each itemlist In List 工作 表 .Listltems "循环 工作 表 列 表 中 所 有 项 目 

If itemlist.Checked Then 检测 项 目 是 否 被 选中 
checkCount = checkCount + 1 ' 记 录 被 选中 项 目 

End ff 

Next 

If checkCount = List 工作 表 .Listltems.Count Then 判断 是 否 全 部 项 目 被 选中 
chk 全 部 勾 选 .Value = True 选中 全 部 复 选 框 
chk 全 部 取消 .Value = False "取消 选中 全 部 复 选 杠 

End If 

If checkCount = 0 Then 检测 是 否 全 部 项 目 未 选中 


chk 全 部 勾 选 .Value = False 选中 全 部 复 选 框 
chk 全 部 取消 .Value = True "选中 全 部 复 选 框 
End 上 f 
判断 被 勾 选 项 目 数 是 否 在 0 和 项 目 总 数量 间 
If checkCount > 0 And checkCount < List 工作 表 .Listltems.Count Then 


chk 全 部 勾 选 .Value = False ' 取 消 选中 全 部 复 选 框 
chk 全 部 取消 .Value = False 选中 全 部 复 选 框 
End 上 f 
End Sub 


12.6.7 ”添加 删除 选 定 项 过 程 代码 设计 


选 


当 项 目 被 选中 时 ， 将 在 数据 库 中 添加 该 项 目 。 当 取消 


选 上 


记录 集 的 工作 短路 和 
工作 短 ， 而 工作 表 名 字段 即 为 该 工作 表 名 称 。 然 后 程 


上 


添加 删除 选 定 项 过 程 根据 传 递 列 表 项 目 对 象 被 
1 情况 ， 对 数据 库 中 该 项 目的 信息 进行 相应 处 理 。 


,时 ， 过 程 将 该 记录 从 数据 库 中 出 除 。 网 
旺 序 首先 从 数据 库 的 工作 表 中 获取 一 记录 集 ,该 是 天 
段 为 当前 选 定 工作 表 所 处 的 


则 当前 项 目的 选 定 状态 ， 当 被 选 定时 ， 将 向 该 记 


录 集 添加 新 记录 ， 否 则 将 该 记录 删除 。 该 过 程 的 流程 
图 如 图 12-34 所 示 。 图 12-34 添加 删除 选 定 项 目 过 程 流程 


Private Sub 添加 删除 选 定 项 (itemlist As Listltem) 

Dim strSQL As String 

On Error Resume Next 

strSQL = "from [工作 表 ] where 工作 簿 路 径 =" & List 选 定 工作 簿 .Text & _ 


"and 工作 表 名 =" & itemlist.Text & "$" 生成 查询 字符 串 
rs.Close "关闭 记录 集 
rs.Open "select * " & strSQL, cnn 临时 数据 往 , adOpenKeyset, adLockOptimistic ”打开 记录 集 
If itemlist.Checked = True Then 检测 项 目 是 否 被 
选 定 

On Error GoTo 0 
rs.AddNew "添加 新 记录 
rs.Fields(" 工 作 簿 路 径 ") = List 选 定 工作 簿 .Text "设置 工作 簿 路 径 
字段 的 值 
rs.Fields(" 工 作 表 名 ") = itemlist. Text & "$" "设置 工作 表 名 字 
段 的 值 
rs.Update 更 新 记录 表 
Else 
rs.Delete ' 删 除 记录 
rs.Update 更 新 记录 表 
End If 
Set rs = Nothing 
End Sub 


-~ 
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12.7 保存 文件 窗口 设计 


保存 文件 窗口 用 于 设置 备份 工作 短 的 保存 位 置 。 在 该 窗口 中 包含 了 一 列表 ， 该 列表 显示 
了 所 有 用 户 已 经 选择 需要 备份 的 工作 表 。 用 户 根据 该 列表 可 以 再 次 检查 需要 备份 的 工作 表 。 

在 窗口 中 有 一 个 备用 文件 名 复合 框 ， 该 复合 框 列 出 了 所 有 源 表 工 作 敌 的 非 重 复 名 称 。 当 
用 户 命名 备份 工作 夭 时 需要 以 源 工作 夭 名 称 为 基础 时 ， 可 以 从 中 选择 。 单 击 【 浏 览 】 按 钮 设 
置 备份 位 置 时 ， 程 序 设置 了 一 个 默认 保存 文件 名 。 该 文件 名 使 用 了 备份 文件 名 加 上 当前 时 间 ， 
从 而 保证 文件 名 的 非 重 复 。 


12.7.1 窗口 界面 设计 


窗口 中 包含 了 2 个 框架 控件 、3 个 标签 控件 、1 个 ListView 控件 、1 个 文本 框 控件 、!1 个 复合 
框 控 件 和 3 个 按钮 控件 。 表 12-8 给 出 了 这 些 控件 的 具体 说 明 。 如 图 12-35 所 示 为 该 窗口 的 界面 。 


表 12-8 ”保存 文件 窗口 控件 列表 


控 件 名 控件 类 型 控件 说 明 

Frame 已 选 工作 表 “| 框架 a 人 工作 表 列 表 信 息 的 控件 。 框架 中 只 有 一 
个 ListView 控件 

LabelSelectedSheet _ | 标签 该 控件 在 已 选 工作 表 框 架 中 用 于 显示 提示 信息 

ListViewResult ListView 该 控件 用 于 显示 在 选择 工作 表 步 又 中 用 户 选择 的 所 有 工作 表 的 信息 

Frame 备份 文件 设置 | 框架 该 控件 包含 了 所 有 用 于 设置 备份 工作 钴 保存 位 置 的 控件 

LabelBackUpLoc | 标签 显示 设置 保存 位 置 的 提示 信息 

txtFileLoc 文本 框 该 控件 显示 用 户 设置 的 备份 工作 矫 保存 位 置 

btnBrowse 按钮 该 控件 打开 一 个 文件 路 径 获 取 窗 口 

LabelDefFileName “| 标签 该 标签 显示 备用 文件 名 的 提示 信息 

ten 复合 杠 该 复合 框 包含 所 有 的 备用 文件 名 的 名 称 。 这 些 名 称 是 从 用 户 选 定 工作 簿 
名 称 中 获取 的 

btnPreStepLoc 按钮 单 击 该 按钮 将 回 到 上 一 步 设 置 工作 表 窗 口中 

btnOKLoc 按钮 单 击 该 按钮 后 ， 程 序 将 按照 用 户 的 设置 完成 保存 备份 工作 短 任 务 


12-35 ”保存 文件 窗口 界面 
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制作 该 窗口 的 步骤 如 下 : 

(1) 在 Excel 2007 的 VBE 开发 环境 下 依次 选择 【插入 】| 【用户 窗 体 】 命 令 ， 在 属性 窗 
口中 设置 新 建立 窗口 的 名 称 属性 为 “frm 保存 位 置 ”， 如 图 12-36 所 示 。 

(2) 在 工具 箱 中 选择 框架 控件 。 在 窗口 中 依次 插入 两 个 框架 控件 。 随 后 在 属性 窗口 依次 
设置 这 两 个 框架 控件 的 名 称 为 “Frame 已 选 工作 表 ” 和 “Frame 备份 文件 设置 ”，Caption 属 
性 依次 设置 为 “已 选 工作 表 查 看 : ”和 “备份 文件 设置 : ”， 如 图 12-37 所 示 。 


| 原 性 -frm 保存 位 置 四 


图 12-36 ”保存 位 置 窗 体 属性 设计 图 12-37 保存 位 置 窗 体 设计 效果 


(3) 在 工具 箱 中 选择 标签 控件 。 在 “已 选 工作 表 : ”框架 的 上 部 插入 一 个 标签 控件 ， 然 
后 在 “备份 文件 设置 : ”框架 中 连续 插入 两 个 标签 控件 。 随 后 在 属性 窗口 中 依次 设置 这 3 个 
标签 控件 的 名 称 属 性 为 LabelSelectedSheet、LabelBackUpLoc 和 LabelDefFileName，Caption 
属性 依次 设置 为 “已 选 定 工 作 表 (如 需 修改 请 回 上 一 步 ): ”、“ 选 择 备份 存储 位 置 : ”和 “ 备 
选 文件 名 : ”。 

(4) 在 工具 箱 中 选择 ListView 控件 。 在 “已 选 定 工作 表 : ”框架 中 插入 一 个 ListView 控 
件 。 随 后 在 属性 窗口 中 设置 该 控件 的 名 称 属性 为 ListViewResult， 如 图 12-38 所 示 。 

(5) 在 工具 箱 中 选择 文本 框 控件 。 在 “备份 文件 设置 : ”框架 中 插入 一 个 文本 框 控件 。 
随后 在 属性 窗口 中 设置 该 控件 的 名 称 属性 为 txtFileLoc，SelectionMargin 属性 设置 为 False， 
如 图 12-39 所 示 。 


习 E| 
ListyierResult ListVier = stileLoe Texthox = 


图 12-38 ”ListView 控件 属性 设计 图 12-39 ”设置 文本 框 控件 的 SelectionMargin 属性 


Ah 
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(6) 在 工具 箱 中 选择 复合 框 控 件 。 在 “备份 文件 设置 : ”框架 的 “ 备 选 文件 名 : ”标签 
右 侧 插入 一 个 复合 框 控件 。 随 后 在 属性 窗口 中 设置 该 复合 框 的 名 称 属性 为 ListFileName， 
SelectionMargin 属性 设置 为 False。 

(7) 在 工具 箱 中 选择 按钮 控件 。 在 “备份 文件 设置 ”框架 的 文本 框 右 侧 插入 一 个 按钮 控 
件 ， 然 后 在 窗口 底部 再 插入 两 个 按钮 控件 。 随 后 在 属性 窗口 中 依次 设置 这 3 个 按钮 的 名 称 属 
性 为 bnBrowse、btnPreStepLoc 和 btnOKLoc 。 


12.7.2 ”窗口 事件 与 ListView 事件 代码 设计 


本 小 节 将 窗口 事件 和 ListView 控件 的 事件 代码 放置 在 一 起 加 以 介绍 。ListView 控件 事件 
代码 很 少 ， 因 而 不 再 单独 加 以 介绍 。 本 部 分 包含 了 窗口 激活 事件 、 窗 口 扼 载 事 件 以 及 ListView 
控件 项 目 单 击 事件 。 在 窗口 中 还 使 用 到 了 一 个 局 部 变量 m_fileLoc， 该 变量 用 于 保存 用 户 设置 
的 保存 文件 名 位 置信 息 。 以 下 是 几 个 事件 的 具体 功能 介绍 : 

口 ”窗口 激活 事件 ， 窗 口 激活 时 ， 需 要 根据 用 户 设 置 的 语言 设置 刷新 窗口 语言 显示 和 更 

新 ListView 控件 的 标题 显示 ， 然 后 程序 从 数据 库 中 读 取 已 选 定 需要 备份 的 工作 表 的 
信息 到 ListView 控件 ， 最 后 程序 将 默认 的 备 选 文件 名 添加 到 备 选 文件 名 复合 框 中 。 

口 ”窗口 卸载 事件 ， 当 用 户 选择 退出 该 窗口 时 ， 程 序 将 会 直接 退出 程序 。 这 里 只 调用 了 

两 个 Unload 事件 ， 分 别 是 卸载 本 窗口 和 选择 工作 表 窗 口 。 在 站 载 选择 工作 表 窗 口中 
包含 了 退出 系统 的 操作 ， 该 部 分 代码 请 见 选 择 工 作 表 窗 口 代码 介绍 。 

口 ”ListView 控件 项 目 单 击 事件 : 因为 可 能 该 工作 短 的 路 径 字 符 串 很 长 , 造成 该 字符 串 无 

法 被 ListView 控件 全 部 显示 。 当 ListView 控件 的 项 目 被 单 击 时 ， 需 要 将 被 选 定 项 目 
的 路 径 信息 通过 ToolTip 属性 显示 出 来 。 

以 下 是 这 几 个 事件 的 代码 解释 : 

Private m _fileLoc As String 

Private Sub ListViewResult_ltemClick(ByVal ltem As MSComctlLib. Listltem) 

ltem.TooltipText = ltem.Subltems(1) "设置 提示 信息 内 容 

End Sub 


Private Sub UserForm_Activate () 


刷新 窗 体 语言 显示 Me "根据 用 户 语言 显示 设置 刷新 窗口 语言 显示 
刷新 已 选 工作 表 列 表 "刷新 ListView 控件 的 显示 

刷新 已 选择 表 ' 从 数据 库 中 载 入 ListView 控件 的 项 目 
默认 保存 文件 名 ' 初 始 化 备 选 文件 名 复合 框 项 目 

End Sub 


Private Sub UserForm_Terminate() 


Unload Me "卸载 本 窗口 
Unload frm 选择 工作 表 "卸载 选择 工作 表 窗 口 
End Sub 


5 办 公 应 用 非 峰 之 禾 
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12.7.3 ”按钮 代码 设计 


本 窗口 中 包含 了 3 个 按钮 ， 本 小 节 将 依次 介绍 这 3 个 按钮 控件 的 代码 。 以 下 是 这 3 个 按 


钮 的 功能 介绍 : 


口 【浏览 】 按 钮 单 击 事件 ， 单 击 该 按钮 后 ， 弹 出 文件 名 路 径 获取 窗口 。 然 后 程序 将 该 路 
径 字 符 串 显示 到 路 径 文本 框 中 , 并 且 将 该 字符 串 保存 到 临时 变量 中 , 以 供 其 他 过 程 调用 。 

口 【上 一 步 】 按 钮 单 击 事件 ， 单 击 该 按钮 后 ， 将 退回 到 选择 工作 表 窗口 。 当 用 户 需 要 
修改 备份 工作 表 时 ， 不 能 在 该 窗口 中 完成 修改 设置 ， 必 须 回 到 选择 工作 表 窗 口中 。 

口 【确认 】 按 钮 单 击 事件 : 单 击 该 按钮 后 ， 将 调用 合并 工作 表 过 程 完成 备份 工作 表 任 务 。 

以 下 是 这 几 个 按钮 单 击 事件 代码 的 解释 : 

Private Sub btnBrowse_Click() 


Dim strFileLoc As String, defFileName As String 
Dim strFileFilter As String 


' 设 置 文件 筛选 条 件 字符 串 
strFileFilter = "Excel2000-2003 file(*.xls),*.xls,Excel 2007 file(*.xlsx),*.xlsx" 
If Len(ListFileName.Text) Then ' 检 测 用 户 是 否 选择 了 备 选 文件 名 


defFileName = ListFileName & "-" & FormatDateTime(Now, vbShortDate) & _ 
"-" & Replace(FormatDateTime(Now, vbShortTime), "", ") “设置 默认 保存 文件 名 

和 打开 文件 路 径 获取 窗口 ， 此 时 显示 的 文件 名 为 默认 文件 名 。 最 后 将 用 户 选择 文件 的 路 径 保存 到 临时 变量 中 

strFileLoc = Application.GetSaveAsFilename(lnitialFileName:=defFileName， 
filefilter:=strFileFilter) 
Else 

' 打 开 文 件 路 径 获 取 窗 口 ， 将 用 户 选择 文件 的 路 径 保 存 到 临时 变量 中 

strFileLoc = Application.GetSaveAsFilename!(InitialFileName:="", filefilter:=strFileFilter) 
End If 


If InStr(1, strFileLoc, Application.PathSeparator) Then "检测 用 户 是 否 选择 了 文件 
m_fileLoc = strFileLoc "保存 备份 文件 名 的 路 径 
txtFileLoc.Value = strFileLoc ' 将 路 径 显 示 在 文本 框 中 

End If 

End Sub 

Private Sub btnOKLoc_Click() 

If Len(txtFileLoc.Text) Then ' 检 测 用 户 是 否 设 置 了 保存 文件 路 径 
CombineWorkBook Trim(txtFileLoc. Text) ' 开 始 备份 工作 表 

End If 

End Sub 

Private Sub btnPreStepLoc Click() 

Me.Hide "隐藏 本 窗口 

frm 选择 工作 表 .Show ' 显 示 选 择 工作 表 窗 口 

End Sub 

代码 说 明 : 


在 浏览 按钮 的 单 击 事件 代码 中 ， 最 后 确认 用 户 是 否 选 择 了 文件 时 ， 其 判断 的 依据 是 最 后 


的 文件 路 径 中 是 否 包 含 了 “\” 字 符 。 无 论 用 户 选择 的 文件 位 于 根 目录 还 是 其 他 位 置 ， 都 必然 


人 GD 


包含 了 路 径 分 隔 符号 。 而 未 选择 文件 时 ， 返 回 的 值 一定 不 包含 该 符号 。 
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12.7.4 刷新 已 选 工作 表 列 表 过 程 代码 设计 


刷新 已 选 工 作 表 列表 过 程 用 于 刷新 ListView 控件 的 显示 。 该 过 程 同 先前 各 个 窗口 中 
ListView 控件 的 刷新 过 程 类 似 。 以 下 是 该 过 程 的 代码 解释 : 


Private Sub 刷新 已 选 工作 表 列表 () 
With ListViewResult 


.Listltems.Clear "清空 控件 所 有 项 目 
.Gridlines = True "显示 网 格 线 
.FullRowSelect = True ' 允 许 整 行 选择 
.MultiSelect = True ' 允 许多 行 选择 
.LabelEdit = lvwManual ' 当 单 击 项 目 时 ， 不 进入 编辑 状态 
.View = lvwReport "设置 控件 显示 模式 
With .ColumnHeaders 
.Clear "清除 标题 
Iflanguageset Then 检测 语言 设置 项 目 
.Add Text:="SheetName", Width:=Me.Width * 0.15 ””' 设 置 英文 表 名 列 标题 
.Add Text:="BookPath", Width:=Me.Width * 0.7 "设置 英文 工作 簿 路 径 列 标题 
Else 
.Add Text:=" 表 名 ", Width:=Me.Width * 0.15 ' 设 置 中 文 表 名 列 标题 
.Add Text:=" 所 在 工作 篇 路径", Width:=Me.Width * 0.7 “设置 中 文 工 作 簿 路 径 列 标题 
End If 
End With 
End With 
End Sub 


12.7.5 ”刷新 已 选择 表 过 程 代码 设计 


刷新 已 选择 表 过 程 代码 用 于 从 数据 库 中 读 取 所 有 
已 经 被 确认 需要 备份 的 工作 表 记 录 到 ListView 控件 了 
中 。 程序 首先 从 数据 库 中 获取 到 工作 表 的 记录 集 并 将 
ListView 控件 所 有 项 目 清除 ， 然 后 循环 所 有 记录 集 项 
目 ， 将 记录 集中 所 有 记录 的 工作 表 名 字段 和 工作 短路 
径 分 别 写 入 ListView 控件 的 对 应 列 中 。 如 图 12-40 所 
示 的 是 该 过 程 的 流程 图 。 

以 下 是 该 过 程 的 代码 解释 : 图 12.40 刷新 己 选 择 工 作 表 过 程 流程 图 

Private Sub 刷新 已 选择 表 () 


On Error Resume Next 


rs.Close ' 关 闭 记录 集 

rs.Open "select * from 工作 表 ", cnn 临时 数据 簿 "从 工作 表 中 获取 记录 集 

ListViewResult.Listltems.Clear ' 清 除 ListView 控件 所 有 项 目 

If rs.RecordCount Then ' 检 测 记录 集 是 否 有 记录 
rs.MoveFirst ' 将 记录 集 指针 移动 到 第 一 条 
Do Until rs.EOF "循环 直到 记录 集 末 端 
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' 添 加 项 目 
With ListViewResult.Listltems.Add(Text:=Left(rs.Fields(" 工 作 表 名 "), Len(rs.Fields(" 工 作 表 名 ")) -1)) 
.Subltems(1) = rs.Fields(" 工 作 短路 径 ") "设置 工作 簿 路 径 
End With 
rs.MoveNext "移动 记录 集 指针 到 下 一 条 
Loop 


End 上 f 

On Error GoTo 0 
Set rs = Nothing 
End Sub 


12.7.6 ”默认 保存 文件 名 过 程 代码 设计 


默认 保存 文件 名 过 程 用 于 从 用 户 选择 的 所 有 工作 簿 中 获取 非 重复 工作 短 名 ， 然 后 将 这 些 
名 称 作为 备 选 文 件 名 复合 框 的 项 目 添加 ， 以 供用 户 选 择 。 

旦 序 首 先 从 数据 库 的 工作 表 中 获取 非 一 致 工作 簿 路径 记 录 集 , 然后 循环 记录 集中 所 有 记录 ， 
从 工作 短路 径 中 获取 工作 敌 名 称 。 这 些 获得 工作 乏 名 称 可 能 是 重复 的 ， 在 这 里 程序 将 剔除 那些 
重复 的 工作 短 名 ， 然 后 程序 将 这 些 工 作 敌 名 称 保存 到 一 个 集合 对 象 中 ， 最 后 程序 将 集合 对 象 中 
获取 的 所 有 工作 夭 名 都 添加 到 备 选 文件 名 复合 框 中 。 如 图 12-41 所 示 的 是 该 过 程 的 流程 图 。 


获取 非 重复 工作 簿 路 径 记 录 集 


获取 记录 集 首 条 记录 


工作 短 名 称 集 合 下 一 项 


将 工作 簿 名 称 添 加 到 集合 中 
记录 集 下 一 条 记录 


刷新 复合 框 控件 项 目 


图 12-41 默认 保存 文件 名 过 程 流程 图 
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在 过 程 中 , 使 用 了 一 个 GoTo 语句 ， 因 而 在 上 面 的 结构 图 中 出 现 了 一 个 穿越 其 他 流程 线 的 
流程 。 读 者 可 以 对 比 下 面 的 代码 理解 图 12-41。 以 下 是 该 过 程 的 代码 解释 : 

Private Sub 默认 保存 文件 名 () 

Dim colFileName As New Collection 


Dim strfileName As String, intPos As Integer, countNum As Boolean 
rs.Open "select distinct 工作 短路 径 from 工作 表 ", cnn 临时 数据 短 ”获取 非 重复 工作 簿 路径 记录 集 


countNum = True "初始 化 countNum 变量 
If rs.RecordCount Then 检测 记录 集 是 否 有 记录 
Do Until rs.EOF "循环 直 到 记录 集 末端 
strfileName = rs.Fields(" 工 作 簿 路 径 ") ' 获 取 工 作 簿 路 径 字符 串 
If InStr(1, strfleName, Application.PathSeparator) Then  _ ' 检 测 路 径 是 否 包 含 “\” 字 符 
获取 工作 筹 名 strfileName 获取 包含 后 缀 的 工作 簿 名 称 
End If 
If InStr(1, strfileName, ".") Then ' 检 测 文件 名 是 否 包 含 点 号 
strfileName = Left(strfileName, InStr(1, strfileName, ".") -1) 
' 获 取 去 掉 后 缀 与 点 号 的 工作 往 名 
End If 
If countNum Then ' 检 测 countNum 是 否 为 真 
colFileName.Add strfileName ' 将 工作 簿 名 直接 添加 到 集合 
Else 
Fori = 1To colFileName.Count "循环 集合 中 所 有 工作 簿 名 称 
lf strfileName = colFileName(i) Then ”' 检 测 当 前 文件 名 是 否 重复 
GoTo NextRS_Handle ' 当 重复 时 ， 跳 到 NextRs_Handle 
End If 
Next 
colFileName.Add strfileName ' 当 没 发 现 重复 时 ， 将 该 名 称 添 加 到 集合 
End If 
NextRS_Handle: 
rs.MoveNext ' 将 记录 移动 到 下 一 条 
countNum = False "标记 countNum 变量 为 假 
Loop 
ListFileName.Clear ' 清 空 复合 框 控件 项 目 
Fori= 1 To colFileName.Count "循环 集合 所 有 项 目 
ListFileName.Addltem colFileName(i) 为 复合 框 控件 添加 项 目 
Next 
ListFileName. Text = colFileName(1) "设置 复合 框 默 认 显示 值 
End If 
End Sub 


在 用 户 选择 了 保存 工作 敌 位 置 并 单 击 【 确 认 】 按 钮 后 ， 可 能 用 户 设置 的 文件 已 经 存在 ， 
此 时 需要 提示 需要 询问 用 户 下 一 步 的 操作 方式 。 该 信息 提示 窗口 即 用 于 提示 用 户 文件 已 存在 
的 消息 ， 并 且 要 求 用户 选 择 一 种 执行 方式 。 该 窗口 中 可 以 选择 覆盖 和 添加 ， 和 覆盖 操作 将 删除 
已 存在 文件 后 ， 将 所 有 需 备份 工作 表 添加 到 新 工作 矢 中 ;添加 操作 将 打开 该 工作 敌 ， 然 后 将 
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需 备份 工作 表 添加 到 该 工作 德 中 。 


12.8.1 窗口 界面 设计 


该 窗口 的 界面 比较 简单 ， 包 含 了 1 个 标签 控件 和 3 个 按钮 控件 。 这 里 不 再 加 以 介绍 详细 
的 设计 步 又， 只 对 控件 加 以 文字 说 明 。LabelTipInf 标签 控件 用 ”EEC 
于 显示 提示 信息 。【 覆 盖 】 与 【添加 】 按 钮 被 单 击 时 ， 程 序 将 。 = we 

把 用 户 的 选择 保存 到 公共 变量 中 。 保 存 备份 工作 德 时 程序 根据 。” [村 | ww | ws | 

该 公共 变量 的 值 完成 覆盖 或 添加 操作 。 如 图 12-42 所 示 的 是 该 。 图 12.4。 信息 提示 窗口 界面 

窗口 的 界面 图 。 


12.8.2 ”窗口 代码 设计 


窗口 的 代码 不 多 ， 这 里 不 再 加 以 分 节 介 绍 。 窗 口 代码 包 含 了 4 个 过 程 ， 分 别 是 
ShowFormTipInf 自 定义 过 程 以 及 3 个 按钮 单 击 事件 过 程 。 该 窗口 并 不 包含 窗口 初始 化 与 激活 
事件 。 在 保存 工作 德 过程 中 使 用 该 窗口 时 ， 将 该 窗口 看 作 了 一 个 对 象 。 通 过 调用 该 窗口 对 象 
的 ShowFormTipInf 过 程 完成 初始 化 任务 。 以 下 是 该 窗口 的 代码 解释 : 

Public Sub ShowFormTiplnf(Language As Boolean) 


With Me 
ffLanguage Then ' 检 测 语言 设置 变量 
.Caption = "File Exist already" "设置 窗口 标题 
.LabelTiplnf.Caption = "File Exist aready! Please select operation!" 
"设置 标签 控件 Caption 属性 
.btnReWrite.Caption = "ReWrite" "设置 覆盖 按钮 的 Caption 属性 
.btnAddln.Caption = "Add In" "设置 添加 按钮 的 Caption 属性 
.btnCancel.Caption = "Cancel" "设置 取消 按钮 的 Caption 属性 
Else 
.Caption = "文件 已 存在 " ' 设 置 窗口 标题 
.LabelTipInf.Caption = "文件 已 存在 ! 请 选择 操作 ! “" ' 设 置 标签 控件 Caption 属性 
.btnReWrite.Caption = "覆盖 " "设置 覆盖 按钮 的 Caption 属性 
.btnAddln.Caption = "添加 " "设置 添加 按钮 的 Caption 属性 
.btnCancel.Caption = "取消 " "设置 取消 按钮 的 Caption 属性 
End If 
.Show 
End With 
End Sub 
Private Sub btnReWrite_Click() 
BtnClicklndex = 1 标记 用 户 单 击 了 覆盖 按钮 
Unload Me ' 扼 载 窗 口 
End Sub 
Private Sub btnAddIn Click() 
BtnClicklndex = 2 标记 用 户 单 击 了 添加 按钮 
Unload Me ' 扼 载 窗 口 


a 
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End Sub 

Private Sub btnCancel Click() 

BtnClicklndex = 3 标记 用 户 单 击 了 取消 按钮 
Unload Me ' 扼 载 窗 口 

End Sub 


12.9 系统 测试 


本 系统 包含 了 两 个 功能 模块 ， 在 该 节 系 统 测试 部 分 也 将 分 为 两 个 部 分 分 别 介绍 这 两 个 功 
能 模块 的 运行 流程 。 需 注意 的 是 ， 本 系统 处 理 的 文件 只 包含 普通 数据 的 Excel 文件 ， 因 而 读者 
在 测试 该 加 载 宏 时 ， 请 不 要 使 用 其 他 文件 类 型 。 


12.9.1 ” 拆 分 工作 簿 模块 功能 测试 


该 小 节 测试 部 分 使 用 的 实例 可 以 在 光盘 的 测试 实例 中 找到 。 该 小 节 使 用 的 工作 矢 文 件 是 
“ 拆 分 工作 短 xls”。 由 于 系统 将 新 拆 分 工作 德 保存 在 该 文件 同一 目录 下 ， 在 读者 测试 时 请 将 
该 文件 复制 到 硬盘 中 ， 以 免 发 生 程序 向 光盘 写 入 数据 的 错误 。 该 文件 包含 了 3 个 工作 表 ， 测 
试 中 将 把 这 3 个 工作 表 分 开 保存 到 2 个 工作 短 中 。 第 二 个 和 第 三 个 工作 表 被 保存 在 同一 个 新 
工作 短 中 。 以 下 是 测试 过 程 ; 

(1) 打开 本 加 载 宏 文件 后 ， 在 Excel 2007 菜单 中 依次 选择 【加 载 项 】| 【工作 敌 拆 分 与 备 
份 】I【 拆 分 工作 筹 】 命 令 。 随 后 程序 打开 拆 分 工作 短 设 置 窗口 。 单 击 窗口 中 的 【浏览 】 按 铅 ， 
找到 “ 拆 分 工作 敌 .xls” 文 件 后 确认 。 此 时 未 分 配 表 列表 中 将 刷新 出 该 工作 矢 的 所 有 工作 表 。 
其 效果 如 图 12-43 所 示 。 


图 12-43 ”测试 拆 分 工作 簿 


(2) 在 已 分 配 工作 表 复 合 框 中 输入 分 组 ， 这 个 分 组 将 作为 新 工作 秒 的 名 称 ， 这 里 无 需 写 
入 后 缀 名称。 在 这 里 输入 “ 拆 分 舌 1”， 然 后 单 击 【 添 加 】 按 钮 。 添 加 成 功 后 ,会 出 现 一 个 提 
示 添 加 成 功 的 消息 框 ( 如 图 12-44 所 示 ) 。 接 着 再 添加 一 个 分 组 “ 拆 分 短 2”， 添 加 完成 后 的 
效果 如 图 12-45 所 示 。 
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图 12-44 ”提示 分 组 项 目 添加 成 功 


图 12-45 添加 分 组 项 目 
(3) 确认 分 组 为 拆 分 短 1， 然 后 在 未 分 配 工作 表 列 表 中 选中 【 拆 分 表 1】 复 选 框 ， 随 后 
了 已 分 配 了 


单 击 【 添 加 】 按钮 (如 图 12-46 所 示 ) 。 此 时 该 拆 分 表 将 从 未 分 配 表 列 表 中 删除 ， 而 被 添加 到 
[ 作 表 列表 中 (如 图 12-47 所 示 ) 


划 
一 浏览 拆 分 工作 簿 : 
[EEC 

厂 未 分 配 工作 表 

口 拆 分 表 2 

口 拆 分 表 3 

开始 拆 分 

图 12-46 ”选中 未 分 配 表 并 添加 


图 12-47 分 配 工作 表 
(4) 在 已 分 配 工作 表 分 组 复合 框 中 选择 “ 拆 分 短 2”， 然 后 依照 前 面 的 操作 ， 将 “ 拆 分 
表 2”s 


“ 拆 分 表 3” 添 加 到 “ 拆 分 舌 2” 分 组 中 。 此 时 未 分 配 表 列 表 中 已 经 没有 项 目 ， 说 明 
已 经 分 配 完毕 。 这 时 的 设置 效果 图 如 图 12-48 所 示 。 单 击 【 开 始 拆 分 】 按 钮 后 ， 程 序 将 按照 以 
上 设置 拆 分 了 


FS 入 Ni 试 文件 \ 拆 分 工作 淖 ,xkx 


[ 作 短 的 工作 表 。 拆 分 完成 后 获得 两 个 新 工作 德 文件 ， 如 图 12-49 所 示 。 
到 


[三 未 分 配 工作 表 : 


工作 表 名 


C pm Et 
图 12-48 分配 剩 余 工 作 表 


图 12-49 ” 拆 分 结果 工作 和 
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12.9.2 ”备份 工作 簿 模块 功能 测试 


备份 工作 短 的 测试 也 使 用 到 了 测试 文件 。 在 上 面 文件 同一 目录 下 ， 读 者 可 以 找到 两 个 
Excel 2007 文件 “合并 工作 短 1.xlsx” 和 “合并 工作 短 2.xlsx”。 它 们 各 自 包含 3 个 工作 表 ， 
以 下 的 测试 将 从 第 一 个 工作 短 中 取出 一 个 工作 表 ， 而 从 第 二 个 工作 夭 中 也 取出 一 个 工作 表 ， 
然后 将 这 两 个 工作 表 备 份 到 一 个 新 工作 适中 。 在 开始 测试 之 前 ， 请 读者 也 将 这 两 个 文件 复制 
到 硬盘 中 。 

(1) 在 Excel 2007 菜单 中 依次 选择 【加 载 项 】| 【工作 竹 拆 分 与 备份 】| 【备份 工作 短 】 命 
令 ， 随 后 程序 打开 备份 工作 德 设置 窗口 。 在 该 窗口 中 单 击 【 打 开 】 按 钮 ， 在 打开 的 文件 获取 
窗口 中 找到 这 两 个 文件 ， 一 次 性 打开 即 可 〈 如 图 12-50 所 示 ) 。 此 时 这 两 个 工作 籍 的 信息 被 自 
动 刷新 到 列表 中 。 然 后 选择 【全 部 色 选 】 复 选 枉 ， 将 两 个 工作 短 选 中 。 这 时 【下 一 步 】 按 钮 
被 激活 ， 单 击 【 下 一 步 】 按 钮 进入 下 一 步 设置 ， 效 果 如 图 12-51 所 示 。 
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EB [Di XJ 


图 12-50 工作 籍 获取 窗口 
加 


Ie 
PESRIETTORTEERTS 
回 计 并 工作 着 .xbx FA 相 往 | 入 文件 | 合并 工作 对 2 xsx 


Ce 厂 全 高 取 光 [Em 个 六 
_ 雪 | 
12-51 ”选中 工作 短 并 进入 下 一 步 设置 
(2) 在 打开 的 工作 表 设 置 窗口 的 当前 工作 德 复合 框 中 选中 【合并 工作 敌 1】， 然 后 在 工 
作 表 列表 中 选择 【合并 表 1】 (如 图 12-52 所 示 ) ， 随 后 在 当前 工作 敌 复 合 框 中 选中 【合并 工 


ag7 


作 短 2】， 并 在 工作 表 列表 中 选中 【合并 表 6】 〈 如 图 12-53 所 示 ) ， 然 后 单 击 【下 一 步 】 按 
钮 进入 保存 工作 短 位 置 设置 步骤 。 


当前 工作 趴 - 当前 工作 了 林 


EE Es| 


图 12-52 选择 第 一 个 工作 适 的 工作 表 图 12-53 ”选择 第 二 个 工作 适 的 工作 表 

(3) 在 保存 位 置 设置 窗口 中 单 击 【 浏 览 】 按 钮 ， 此 时 程序 已 经 根据 默认 文件 名 自动 生成 
文件 的 名 称 。 当 然 读者 也 可 以 自己 修改 该 名 称 ， 这 里 就 使 用 了 这 个 默认 名 称 ， 以 防 有 重复 文件 
存在 (如 图 12-54 所 示 ) 。 设 置 好 保存 位 置 后 , 单 击 窗口 中 的 【确定 】 按 钮 (如 图 12-55 所 示 ) 。 
程序 将 按照 前 面 的 各 步 设 置 备份 工作 表 到 新 工作 短 中 。 备 份 完成 后 的 结果 如 图 12-56 所 示 。 


到 
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图 12-54 ”保存 工作 短文 件 位 置 
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| 禄 条 文件 [ 富 开 工作 之 Lxb 


语 革 1 
语 才 6 。 和 入 济 诺 立 件 | 全 并 工作 福 2.zbx 


三 间 的 禄 件 训 枉 
择 各 从 存 引 位 置 : 


cy 国 合并 工作 等 1-2008-1-12-1216Xls 
[ER 
bs s#Ifxwl 司 


= CD 
12-55 ”设置 保存 位 置 并 开始 备份 


图 12-56 备份 工作 适 文 件 


您 购买 的 书 名 : 您 的 姓名 : 性 别 : 口 男 女 
年 龄 : 文化 程度 : 职 业 : 
邮编 : 通信 地 址 : E-mail: 
您 常用 的 软件 : 1 2 3 4 


您 购买 本 书 的 原因 (可 多 选 ): 
封面 与 装帧 口 引言 目录 口 正文 内 容 口 从 书 风格 口 价格 光盘 口 专业 性 强 口 别人 介绍 
出 版 社 或 作者 名 声 口 售 后 服务 


本 书 最 令 您 满意 的 是 〈 可 多 选 ): 


专业 性 强 、 才 盖 面 | 内 容 翔 实 、 定 位 准确 口 精益 求 精 、 售 后 服务 
您 可 以 承受 的 图 书 价格 : 

20 元 以 下 30 元 以 下 40 元 以 下 口 50 元 以 下 口 只 要 内 容 好 ， 不 论 价格 
您 对 本 书 的 评价 : 
时 面 装帧 : 口 很 好 较 好 - 般 口 不 满意 建议 
印刷 质量 : 口 很 好 较 好 - 般 口 不 满意 建议 
正文 质量 : 口 很 好 较 好 - 般 口 不 满意 建议 
写作 风格 : 口 很 好 较 好 - 般 ] 不 满意 建议 
专业 水 平 : 口 很 好 较 好 - 般 ] 不 满意 建议 
您 希望 增加 哪些 图 书 选 题 : 1 2 3 
您 认为 本 书 有 哪些 错误 : 
章 着 页 码 行 列 图 号 错误 应 改 为 
章 节 页 码 行 列 图 号 错误 应 改 为 
章 节 页 码 行 列 图 号 错误 应 改 为 
章 节 页 码 行 列 图 号 错误 应 改 为 
您 的 其 他 建议 
1 
吉 
EE 
请 填 好 本 卡 后 寄 给 : 
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